yatex
view yahtml.el @ 77:1b172d26b55e
Fix auto-fill movement on Emacs21.
Fix YaTeX:ref.
Support jump/change on AMS-LaTeX's parentheses.
| author | yuuji |
|---|---|
| date | Thu, 01 May 2003 13:38:27 +0000 |
| parents | f41b01fef5d6 |
| children | 0734be649cb8 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; (c ) 1994-2002 by HIROSE Yuuji [yuuji@yatex.org]
3 ;;; Last modified Thu Nov 21 17:55:40 2002 on firestorm
4 ;;; $Id$
6 (defconst yahtml-revision-number "1.70"
7 "Revision number of running yahtml.el")
9 ;;;[Installation]
10 ;;;
11 ;;; First, you have to install YaTeX and make sure it works fine. Then
12 ;;; put these expressions into your ~/.emacs
13 ;;;
14 ;;; (setq auto-mode-alist
15 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))
16 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)
17 ;;; (setq yahtml-www-browser "netscape")
18 ;;; ;Write your favorite browser. But netscape is advantageous.
19 ;;; (setq yahtml-path-url-alist
20 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")
21 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))
22 ;;; ;Write correspondence alist from ABSOLUTE unix path name to URL path.
23 ;;;
24 ;;;[インストール方法]
25 ;;;
26 ;;; yahtml.el, yatexlib.el, yatexprc.el を load-path の通ったディレクト
27 ;;; リにインストールしてください。その後、以下を参考に ~/.emacs に設定を
28 ;;; 追加して下さい。
29 ;;;
30 ;;; (setq auto-mode-alist
31 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))
32 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)
33 ;;; (setq yahtml-www-browser "netscape")
34 ;;; ;お気に入りのブラウザを書いて下さい。netscapeが便利です。
35 ;;; (setq yahtml-path-url-alist
36 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")
37 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))
38 ;;; ;UNIXの絶対パスと対応するURLのリストを書いて下さい。
39 ;;;
40 ;;; HTMLファイル漢字コードが正しく判別されるようにホームディレクトリに
41 ;;; .htaccess ファイルを作り以下のどれか1行を選んで書いて下さい。
42 ;;;
43 ;;; AddType "text/html; charset=Shift_JIS" .html (SJISの場合)
44 ;;; AddType "text/html; charset=iso2022-jp" .html (JISの場合)
45 ;;; AddType "text/html; charset=EUC-JP" .html (EUCの場合)
46 ;;;
47 ;;; .htaccess が作れない場合は
48 ;;; (setq yahtml-kanji-code 2)
49 ;;; ;HTMLファイルの漢字コードを変更する場合は 1=SJIS、2=JIS、3=EUC
50 ;;; ;で設定して下さい。デフォルトは 2 です。
51 ;;;
52 ;;; を適切に書き換えて ~/.emacs に足して下さい。
53 ;;;
54 ;;;[Commentary]
55 ;;;
56 ;;; It is assumed you are already familiar with YaTeX. The following
57 ;;; completing featureas are available: ([prefix] means `C-c' by default)
58 ;;;
59 ;;; * [prefix] b X Complete environments such as `H1' which
60 ;;; normally requires closing tag `</H1>
61 ;;; <a href=foo> ... </a> is also classified into
62 ;;; this group
63 ;;; When input `href=...', you can complete file
64 ;;; name or label(href="#foo") by typing TAB.
65 ;;; * [prefix] l Complete typeface-changing commands such as
66 ;;; `<i> ... </i>' or `<samp> ... </samp>'
67 ;;; This completion can be used to make in-line
68 ;;; tags which is normally completed with [prefix] b.
69 ;;; * [prefix] s Complete declarative notations such as
70 ;;; `<img src="foo.gif">'
71 ;;; `<input name="var" ...>'
72 ;;; * [prefix] m Complete single commands such as
73 ;;; `<br>' or `<hr> or <li>...'
74 ;;; * [prefix] p Insert <p></p> on the point
75 ;;; * M-RET Intelligent newline; if current TAG is one of
76 ;;; ul, ol, or dl. insert newline and <li> or
77 ;;; <dt> or <dd> suitable for current condition.
78 ;;; * menu-bar yahtml Complete all by selecting a menu item (Though I
79 ;;; hate menu, this is most useful)
80 ;;; * [prefix] g Goto corresponding Tag or HREF such as
81 ;;; <dl> <-> </dl> or href="xxx".
82 ;;; Or invoke image viewer if point is on <img src=...>.
83 ;;; * [prefix] k Kill html tags on the point. If you provide
84 ;;; universal-argument, kill surrounded contents too.
85 ;;; * [prefix] c Change html tags on the point.
86 ;;; When typeing [prefix] c on `href="xxx"', you can
87 ;;; change the reference link with completion.
88 ;;; * [prefix] t j Call weblint on current file.
89 ;;; * [prefix] t p View current html with WWW browser
90 ;;; (To activate this, never fail to set the lisp
91 ;;; variable yahtml-www-browser. Recommended value
92 ;;; is "netscape")
93 ;;; * [prefix] a YaTeX's accent mark's equivalent of yahtml.
94 ;;; This function can input $lt, $gt or so.
95 ;;; * [prefix] ; Translate chars of `>', `<', `&', and `"' to
96 ;;; `>', `<', `&', `"' respectively
97 ;;; in the region.
98 ;;; * [prefix] : Do translation opposite to above, in the region.
99 ;;; * [prefix] # Translate unsafe-chars and unreserved-chars to
100 ;;; URLencoded string in the region.
101 ;;;
102 ;;;[キーの説明]
103 ;;;
104 ;;; 以下の説明において、特にカスタマイズをしていない限り、[prefix] は
105 ;;; C-c キーを意味します。
106 ;;;
107 ;;; * [prefix] b X `</H1>' といった終了タグが必要となる`H1'のよう
108 ;;; な環境を補完入力します。<a href=foo> ... </a>
109 ;;; もこのグループです。
110 ;;; `href=...' と入力した後、TABキーを押すことで、
111 ;;; ファイル名や (href="#foo") のようなラベルも補完
112 ;;; できます。
113 ;;; * [prefix] s 以下のような宣言の補完を行います。
114 ;;; `<img src="foo.gif">'
115 ;;; `<input name="var" ...>'
116 ;;; * [prefix] l `<i> ... </i>' や `<samp> ... </samp>' のよう
117 ;;; なテキストスタイル指定のタグを補完します。
118 ;;; この補完機能は通常 [prefix] b で補完できるものを
119 ;;; 一行内で書きたいときにも用いることが出来ます。
120 ;;; * [prefix] m `<br>' や `<hr> '、`<li>' 等の単体タグの補完
121 ;;; を行います。
122 ;;; * [prefix] p カーソル位置に<p></p>を挿入します。
123 ;;; * M-RET おまかせ改行; もしul、ol、dl等のタグ(リスト)を
124 ;;; 使っている場合に、環境に合わせて改行と <li>、
125 ;;; <dt>、<dd>を入力します。
126 ;;; * menu-bar yahtml 選択したアイテムをメニューより補完できます。
127 ;;; (私はメニューが嫌いなんですが、htmlに関してはメ
128 ;;; ニューは一番ありがたいかも)
129 ;;; * [prefix] g 対応するタグ、<dl> <-> </dl> や href="xxx" の
130 ;;; ような TAG にジャンプします。
131 ;;; <img src=...> の場合はイメージビューワを呼び出
132 ;;; します。href=hoge.html の場合はhoge.htmlに飛びま
133 ;;; す。
134 ;;; * [prefix] k ポイント上の HTML タグを消去します。
135 ;;; もし universal-argument を付けた場合(C-uを先に押
136 ;;; す)HTMLタグで囲まれた内容も同時に消去します。
137 ;;; * [prefix] c ポイント上のタグを変更します。
138 ;;; `href="xxx"'の上で [prefix] c を利用した場合は、
139 ;;; 参照しているリンクを補完機能を使いながら変更で
140 ;;; きます。
141 ;;; * [prefix] t j カレントファイルに対して jweblint を呼び出しま
142 ;;; す。
143 ;;; * [prefix] t p WWW ブラウザでカレントファイルを表示します。
144 ;;; (lisp変数 yahtml-www-browser の設定をお忘れな
145 ;;; く。お推めは "netscape" で、ねすけの場合既にねす
146 ;;; けが起動されていた場合そのねすけに Reload 命令を
147 ;;; 送るという芸当が出来ます)
148 ;;; * [prefix] a YaTeX のアクセント記号補完と同じです。
149 ;;; < > 等が入力できます。
150 ;;; * [prefix] ; 指定したリジョン中の > < & " をそれぞれ
151 ;;; > < & " に変換します。
152 ;;; * [prefix] : 指定したリジョン中で上と逆の変換をします。
153 ;;; * [prefix] # 指定したリジョン中で%エンコードの必要な文字が
154 ;;; あればそれらをエンコードします。
155 ;;; * [prefix] ESC yahtml-mode を抜け yahtml-mode に入る前に動作し
156 ;;; ていたメジャーモードに戻ります。
157 ;;;
158 ;;; [謝辞]
159 ;;;
160 ;;; fj野鳥の会の皆さんには貴重な助言を頂きました。また、下に示す方々には
161 ;;; 特に大きな協力を頂きました。あわせてここに感謝申し上げます。
162 ;;;
163 ;;; * 横田和也さん(マツダ)
164 ;;; マニュアルの和訳をして頂きました。
165 ;;; * 吉田尚志さん(NTT Data)
166 ;;; Mule for Win32 での動作のさせ方を教えて頂きました。
167 ;;; (というかほとんどやってもらった ^^;)
168 ;;;
171 ;(require 'yatex)
172 (require 'yatexlib)
173 ;;; --- customizable variable starts here ---
174 (defvar yahtml-prefix "\C-c"
175 "*Prefix key stroke of yahtml functions.")
176 (defvar yahtml-image-viewer "xv" "*Image viewer program")
177 (defvar yahtml-www-browser "netscape"
178 "*WWW Browser command")
179 (defvar yahtml-kanji-code 2
180 "*Kanji coding system number of html file; 1=sjis, 2=jis, 3=euc")
181 ;;(defvar yahtml-coding-system
182 ;; (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))
183 ;; "Kanji coding system")
184 (and (featurep 'mule)
185 (integerp yahtml-kanji-code)
186 (setq yahtml-kanji-code
187 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))))
189 (defvar yahtml-fill-column 72 "*fill culumn used for yahtml-mode")
190 (defvar yahtml-fill-prefix nil "*fill prefix for yahtml-mode")
192 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")
193 (defvar yahtml-path-url-alist nil
194 "*Alist of unix path name vs. URL name of WWW server.
195 Ex.
196 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")
197 (\"/home/yuuji/http\" . \"http://www.gentei.org/~yuuji\"))")
198 (defvar yahtml-directory-index "index.html"
199 "*Directory index file name;
200 Consult your site's WWW administrator.")
202 (defvar yahtml-environment-indent 1
203 "*Indentation depth of HTML's listing environment")
205 (defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)
206 "Whether yatex mode is running on Japanese environment or not.")
208 (defvar yahtml-lint-program (if YaTeX-japan "jweblint" "weblint")
209 "*Program name to lint HTML file")
210 (defvar yahtml-hate-too-deep-indentation nil
211 "*Non-nil for this variable suppress deep indentation in listing environments.")
213 (defvar yahtml-always-/p nil
214 "*Those who always use <p> with </p> set this to t.")
216 (defvar yahtml-p-prefered-env-regexp "^\\(body\\|dl\\|blockquote\\)"
217 "*Regexp of envs where paragraphed sentences are prefered.")
219 (defvar yahtml-template-file "~/http/template.html"
220 "*Template HTML file. It'll be inserted to empty file.")
222 (defvar yahtml-prefer-upcases nil
223 "*Non-nil for preferring upcase TAGs")
225 (defvar yahtml-prefer-upcase-attributes nil
226 "*Non-nil for preferring upcase attributes")
228 (defvar yahtml-server-type 'apache
229 "*WWW server program type")
231 (defvar yahtml-apache-access-file ".htaccess"
232 "*Server access file name for apache")
234 (defvar yahtml-use-css t "*Use stylesheet or not")
236 (defvar yahtml-image-inspection-bytes 10000 ;256
237 "*Number of bytes to inspect the image for geometry information")
238 (defvar yahtml:img-default-alt-format "%xx%y(%sbytes)"
239 "*Default format of img entity's ALT attributes.
240 %x: width, %y: height, %s: size in bytes, %c: first comment string,
241 %f: filename")
243 (defvar yahtml-faithful-to-htmllint nil)
244 (defvar yahtml-error-line-regexp
245 "^\\(.*\\)(\\([0-9]+\\)):\\|^line \\([0-9]+\\)"
246 "*Regexp of error position which is produced by lint program.")
248 (defvar yahtml-translate-hyphens-when-comment-region t
249 "*Non-nil for translate hyphens to - when comment-region")
250 (defvar yahtml-escape-chars 'ask
251 "*Escape reserved characters to URL-encoding or not.
252 Nil for never, t for everytime, and 'ask for inquiring
253 at each reserved chars.")
255 (defvar yahtml-use-font-lock (and (featurep 'font-lock)
256 (fboundp 'font-lock-fontify-region))
257 "*Non-nil means to use font-lock to fontify buffer.")
259 (defvar yahtml-use-hilit19 (and (featurep 'hilit19)
260 (not yahtml-use-font-lock))
261 "*Non-nil means to Use hilit19 to highlight buffer")
263 (defvar yahtml-mode-abbrev-table nil
264 "*Abbrev table in use in yahtml-mode buffers.")
265 (define-abbrev-table 'yahtml-mode-abbrev-table ())
267 (defvar yahtml-indentation-boundary "^\\s *<h[1-3]>"
268 "*Boundary regexp for indentation calculation.")
270 ;;; --- customizable variable ends here ---
271 (defvar yahtml-prefix-map nil)
272 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")
273 (defvar yahtml-lint-buffer-map nil "Keymap used in lint buffer.")
274 (defvar yahtml-shell-command-option
275 (or (and (boundp 'shell-command-option) shell-command-option)
276 (if (eq system-type 'ms-dos) "/c" "-c")))
277 (defvar yahtml-use-highlighting (or yahtml-use-font-lock yahtml-use-hilit19))
279 (defun yahtml-define-begend-key-normal (key env &optional map)
280 "Define short cut yahtml-insert-begend key."
281 (YaTeX-define-key
282 key
283 (list 'lambda '(arg) '(interactive "P")
284 (list 'yahtml-insert-begend 'arg env))
285 map))
287 (defun yahtml-define-begend-region-key (key env &optional map)
288 "Define short cut yahtml-insert-begend-region key."
289 (YaTeX-define-key key (list 'lambda nil '(interactive)
290 (list 'yahtml-insert-begend t env)) map))
292 (defun yahtml-define-begend-key (key env &optional map)
293 "Define short cut key for begin type completion both for
294 normal and region mode. To customize yahtml, user should use this function."
295 (yahtml-define-begend-key-normal key env map)
296 (if YaTeX-inhibit-prefix-letter nil
297 (yahtml-define-begend-region-key
298 (concat (upcase (substring key 0 1)) (substring key 1)) env map)))
300 (if yahtml-mode-map nil
301 (setq yahtml-mode-map (make-sparse-keymap)
302 yahtml-prefix-map (make-sparse-keymap))
303 (define-key yahtml-mode-map yahtml-prefix yahtml-prefix-map)
304 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)
305 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)
306 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))
307 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)
308 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)
309 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)
310 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)
311 (define-key yahtml-mode-map "&" 'yahtml-insert-amps)
312 (let ((map yahtml-prefix-map))
313 (YaTeX-define-key "^" 'yahtml-visit-main map)
314 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)
315 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)
316 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)
317 (and YaTeX-emacs-19 window-system
318 (progn
319 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
320 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
321 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
322 (YaTeX-define-key "v" 'yahtml-version map)
323 (YaTeX-define-key "s" 'yahtml-insert-form map)
324 (YaTeX-define-key "l" 'yahtml-insert-tag map)
325 (YaTeX-define-key "L" 'yahtml-insert-tag-region map)
326 (YaTeX-define-key "m" 'yahtml-insert-single map)
327 (YaTeX-define-key "n" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<BR>" "<br>"))) map)
328 (YaTeX-define-key "-" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<HR>" "<hr>") "\n")) map)
329 (YaTeX-define-key "p" 'yahtml-insert-p map)
330 (if YaTeX-no-begend-shortcut
331 (progn
332 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)
333 (YaTeX-define-key "b" 'yahtml-insert-begend map))
334 (yahtml-define-begend-key "bh" "html" map)
335 (yahtml-define-begend-key "bH" "head" map)
336 (yahtml-define-begend-key "bt" "title" map)
337 (yahtml-define-begend-key "bT" "table" map)
338 (yahtml-define-begend-key "bb" "body" map)
339 (yahtml-define-begend-key "bc" "center" map)
340 (yahtml-define-begend-key "bd" "dl" map)
341 (yahtml-define-begend-key "bu" "ul" map)
342 (yahtml-define-begend-key "b1" "h1" map)
343 (yahtml-define-begend-key "b2" "h2" map)
344 (yahtml-define-begend-key "b3" "h3" map)
345 (yahtml-define-begend-key "ba" "a" map)
346 (yahtml-define-begend-key "bf" "form" map)
347 (yahtml-define-begend-key "bs" "select" map)
348 (YaTeX-define-key "b " 'yahtml-insert-begend map)
349 (YaTeX-define-key "B " 'yahtml-insert-begend-region map)
350 )
351 (YaTeX-define-key "e" 'YaTeX-end-environment map)
352 (YaTeX-define-key ">" 'yahtml-comment-region map)
353 (YaTeX-define-key "<" 'yahtml-uncomment-region map)
354 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)
355 (YaTeX-define-key "k" 'yahtml-kill-* map)
356 (YaTeX-define-key "c" 'yahtml-change-* map)
357 (YaTeX-define-key "t" 'yahtml-browse-menu map)
358 (YaTeX-define-key "a" 'yahtml-complete-mark map)
359 (YaTeX-define-key "'" 'yahtml-prev-error map)
360 (YaTeX-define-key ";" 'yahtml-translate-region map)
361 (YaTeX-define-key ":" 'yahtml-translate-reverse-region map)
362 (YaTeX-define-key "#" 'yahtml-escape-chars-region map)
363 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
364 (YaTeX-define-key "\e" 'yahtml-quit map)
365 )
366 (substitute-all-key-definition
367 'fill-paragraph 'yahtml-fill-paragraph yahtml-mode-map)
368 (substitute-all-key-definition
369 'kill-buffer 'YaTeX-kill-buffer yahtml-mode-map))
371 (if yahtml-lint-buffer-map nil
372 (setq yahtml-lint-buffer-map (make-keymap))
373 (define-key yahtml-lint-buffer-map " " 'yahtml-jump-to-error-line))
376 (defvar yahtml-paragraph-start
377 (concat
378 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|[bhtd][rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\)\\b")
379 "*Regexp of html paragraph separater")
380 (defvar yahtml-paragraph-separate
381 (concat
382 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|[bhtd][ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\|!--\\)\\b")
383 "*Regexp of html paragraph separater")
384 (defvar yahtml-syntax-table nil
385 "*Syntax table for yahtml-mode")
387 (if yahtml-syntax-table nil
388 (setq yahtml-syntax-table
389 (make-syntax-table (standard-syntax-table)))
390 (modify-syntax-entry ?\< "(>" yahtml-syntax-table)
391 (modify-syntax-entry ?\> ")<" yahtml-syntax-table)
392 (modify-syntax-entry ?\n " " yahtml-syntax-table)
393 )
394 (defvar yahtml-command-regexp "[A-Za-z0-9]+"
395 "Regexp of constituent of html commands.")
397 ;;; Completion tables for `form'
398 (defvar yahtml-form-table
399 '(("img") ("input") ("link") ("meta")))
400 (defvar yahtml-user-form-table nil)
401 (defvar yahtml-tmp-form-table nil)
402 (defvar yahtml-last-form "img")
404 (defvar yahtml-env-table
405 '(("html") ("head") ("title") ("body") ("dl") ("ul") ("ol") ("pre")
406 ("a") ("form") ("select") ("center") ("textarea") ("blockquote")
407 ("OrderedList" . "ol")
408 ("UnorderedList" . "ul")
409 ("DefinitionList" . "dl")
410 ("Preformatted" . "pre")
411 ("table") ("thead") ("tbody") ("tfoot") ("caption") ("tr") ("th") ("td")
412 ("address")
413 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6")
414 ;; ("p") ;This makes indentation screwed up!
415 ("style") ("div") ("object")
416 ))
418 ;(defvar yahtml-itemizing-regexp
419 ; "\\(ul\\|ol\\|dl\\)"
420 ; "Regexp of itemizing forms")
422 (defvar yahtml-user-env-table nil)
423 (defvar yahtml-tmp-env-table nil)
425 ;;; Completion tables for typeface designator
426 (and yahtml-always-/p
427 (or (assoc "p" yahtml-env-table)
428 (setq yahtml-env-table (cons '("p") yahtml-env-table))))
430 (defvar yahtml-typeface-table
431 (append
432 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("strike") ("s")
433 ("strong") ("var") ("b") ("i") ("tt") ("u") ("big") ("small") ("font")
434 ("sup") ("sub") ("span"))
435 yahtml-env-table)
436 "Default completion table of typeface designator")
437 (defvar yahtml-user-typeface-table nil)
438 (defvar yahtml-tmp-typeface-table nil)
439 (defvar yahtml-last-typeface-cmd "a")
441 (defvar yahtml-single-cmd-table
442 '(("hr") ("br") ("option") ("p")
443 ("HorizontalLine" . "hr")
444 ("BreakLine" . "br")
445 ("Paragraph" . "p")
446 ("Item" . "li")
447 ("DefineTerm" . "dt")
448 ("Description" . "dd")
449 ("dd") ("dt") ("li")
450 )
451 "Default completion table of HTML single command.")
452 (defvar yahtml-user-single-cmd-table nil)
453 (defvar yahtml-tmp-single-cmd-table nil)
454 (defvar yahtml-last-single-cmd nil)
456 (defvar yahtml-current-completion-type nil
457 "Has current completion type. This may be used in yahtml addin functions.")
459 ;(defvar yahtml-struct-name-regexp
460 ; "\\<\\(h[1-6]\\|[uod]l\\|html\\|body\\|title\\|head\\|table\\|t[rhd]\\|pre\\|a\\|form\\|select\\|center\\|blockquote\\)\\b")
461 (defvar yahtml-struct-name-regexp
462 (concat
463 "\\<\\("
464 ;(mapconcat 'car yahtml-typeface-table "\\|")
465 (mapconcat 'car yahtml-env-table "\\|")
466 "\\)\\b")
467 "Regexp of structure beginning.")
469 (defvar yahtml-closable-regexp
470 (concat
471 "\\<\\("
472 (mapconcat 'car yahtml-typeface-table "\\|")
473 (mapconcat 'car yahtml-env-table "\\|")
474 "\\)\\b")
475 "Regexp of any closable elemnts.")
477 (defvar yahtml-indent-listing-constant t
478 "*Nil means indentation for listing obeys the column of `>'.
479 T for static indentation depth")
481 (or (assoc "p" yahtml-env-table)
482 (setq yahtml-env-table (cons '("p") yahtml-env-table)))
485 (defun yahtml-get-user-httpconf-entry (regexp)
486 (cond
487 ((and (eq yahtml-server-type 'apache) ;;check .htaccess
488 buffer-file-name)
489 (let ((dir default-directory)
490 charset af ext (ldir "")
491 line
492 (case-fold-search t)
493 (uid (car (cdr (cdr (file-attributes "."))))))
494 (if (string-match "^[A-Z]:" dir)
495 (setq dir (substring dir 2))) ;remove drive letter
496 (while (and dir
497 (not (string= dir ldir))
498 (equal uid (car (cdr (cdr (file-attributes dir))))))
499 (setq af (expand-file-name yahtml-apache-access-file dir))
500 (if (file-exists-p af)
501 (save-excursion
502 (set-buffer (find-file-noselect af))
503 (save-excursion
504 (goto-char (point-min))
505 (if (re-search-forward regexp nil t)
506 (setq line (buffer-substring
507 (point-beginning-of-line)
508 (point-end-of-line))
509 dir nil)))
510 (kill-buffer (current-buffer))))
511 (if dir
512 (setq ldir dir
513 dir (substring dir 0 (string-match "/$" dir))
514 dir (file-name-directory dir))))
515 line
516 ))
517 (t nil))
518 )
520 (defun yahtml-dir-default-charset ()
521 (let*((fn (file-name-nondirectory (or buffer-file-name "")))
522 (ext (substring fn (or (string-match "\\.[a-z0-9]+$" fn) 0)))
523 (ptn (format "^\\s *AddType.*charset=\\(.*\\)\\%s$" ext))
524 (case-fold-search t)
525 line
526 charset)
527 (if (setq line (yahtml-get-user-httpconf-entry ptn))
528 (progn
529 (string-match ptn line)
530 (setq charset
531 (substring line (match-beginning 1) (match-end 1)))
532 (cond
533 ((string-match "iso-2022-jp" charset)
534 (setq charset 2))
535 ((string-match "euc-jp" charset)
536 (setq charset 3))
537 ((string-match "shift_jis" charset)
538 (setq charset 1))
539 (t (setq charset nil)))
540 (setq dir "")))
541 (if (featurep 'mule)
542 (setq charset (cdr (assq charset YaTeX-kanji-code-alist))))
543 charset))
545 (defun yahtml-get-directory-index ()
546 (let ((line (yahtml-get-user-httpconf-entry "^\\s *DirectoryIndex"))
547 x index-list)
548 ;;s/\\s *$//;
549 (if line
550 (progn
551 (if (string-match "DirectoryIndex\\s +\\(.*\\)\\s *$" line)
552 (setq line (substring line (match-beginning 1) (match-end 1))))
553 (while (string< "" line)
554 (if (setq x (string-match "\\(\\s +\\)" line))
555 (setq index-list (cons (substring line 0 x) index-list)
556 line (substring line (match-end 1)))
557 (setq index-list (cons line index-list)
558 line ""))
559 )
560 (or (nreverse index-list)
561 (if (listp yahtml-directory-index)
562 yahtml-directory-index
563 (list yahtml-directory-index)))))))
565 (defvar yahtml-mode-old-mode nil)
566 (defun yahtml-mode ()
567 (interactive)
568 (let ((old-mm major-mode)) ;Emacs21.0.95 resets major-mode
569 (kill-all-local-variables) ;with kill-all-local-variables
570 (if (not (eq 'yahtml-mode old-mm))
571 (set (make-local-variable 'yahtml-mode-old-mode) old-mm)))
572 (let ((coding (or (yahtml-dir-default-charset) yahtml-kanji-code)))
573 (cond
574 ((and YaTeX-emacs-20 (boundp 'buffer-file-coding-system))
575 (setq buffer-file-coding-system
576 (or (and (fboundp 'set-auto-coding) buffer-file-name
577 (save-excursion (set-auto-coding buffer-file-name (buffer-size))))
578 coding)))
579 ((featurep 'mule)
580 (set-file-coding-system coding))
581 ((boundp 'NEMACS)
582 (make-local-variable 'kanji-fileio-code)
583 (setq kanji-fileio-code coding))))
584 (setq major-mode 'yahtml-mode
585 mode-name "yahtml"
586 YaTeX-current-file-name (file-name-nondirectory
587 (or (buffer-file-name) ""))
588 local-abbrev-table yahtml-mode-abbrev-table)
589 (mapcar
590 (function (lambda (x)
591 (make-local-variable (car x))
592 (set (car x) (if (and (symbolp (cdr x))
593 (boundp (cdr x)))
594 (symbol-value (cdr x))
595 (cdr x)))))
596 '((YaTeX-ec . "")
597 (YaTeX-struct-begin . "<%1%2")
598 (YaTeX-struct-end . "</%1>")
599 (YaTeX-struct-name-regexp . yahtml-closable-regexp)
600 (YaTeX-comment-prefix . "<!--")
601 (YaTeX-coding-system . yahtml-kanji-code) ;necessary?
602 (YaTeX-typesetting-mode-map . yahtml-lint-buffer-map)
603 (fill-prefix . yahtml-fill-prefix) (fill-column . yahtml-fill-column)
604 (paragraph-start . yahtml-paragraph-start)
605 (paragraph-separate . yahtml-paragraph-separate)
606 (comment-start . "<!-- ") (comment-end . " -->")
607 (comment-start-skip . comment-start)
608 (indent-line-function . yahtml-indent-line)))
610 (if yahtml-use-font-lock
611 (progn
612 (yahtml-font-lock-set-default-keywords)
613 (or (featurep 'xemacs)
614 (progn
615 (set (make-local-variable 'font-lock-defaults)
616 '(yahtml-font-lock-keywords nil t))
617 ;;(font-lock-mode -1)
618 (font-lock-mode 1) ;;Why should I fontify again???
619 ;; in yatex-mode, there's no need to refontify...
620 (font-lock-fontify-buffer)
621 ))
622 ))
623 (set-syntax-table yahtml-syntax-table)
624 (use-local-map yahtml-mode-map)
625 (YaTeX-read-user-completion-table)
626 (yahtml-css-scan-styles)
627 (turn-on-auto-fill) ;Sorry, this is prerequisite
628 (and (= 0 (buffer-size)) (file-exists-p yahtml-template-file)
629 (y-or-n-p (format "Insert %s?" yahtml-template-file))
630 (insert-file-contents (expand-file-name yahtml-template-file)))
631 (run-hooks 'text-mode-hook 'yahtml-mode-hook)
633 ;; This warning should be removed after a while(2000/12/2)
634 (let ((fld (or (and (local-variable-p 'font-lock-defaults (current-buffer))
635 font-lock-defaults)
636 (get 'yahtml-mode 'font-lock-defaults))))
637 (and fld (not (memq 'yahtml-font-lock-keywords fld))
638 (YaTeX-warning-font-lock "yahtml"))))
640 (defun yahtml-version ()
641 "Return string of the version of running yahtml."
642 (interactive)
643 (message
644 (concat "Yet Another HTML-mode "
645 (if YaTeX-japan "「HTML屋」" "`yahtml'")
646 " Revision "
647 yahtml-revision-number)))
649 (defun yahtml-quit ()
650 (interactive)
651 (and yahtml-mode-old-mode
652 (fboundp yahtml-mode-old-mode)
653 (funcall yahtml-mode-old-mode)))
655 (defun yahtml-define-menu (keymap bindlist)
656 (cond
657 ((featurep 'xemacs)
658 (let ((name (keymap-name (symbol-value keymap))))
659 (set keymap nil)
660 (mapcar
661 (function
662 (lambda (bind)
663 (setq bind (cdr bind))
664 (if (eq (car (cdr bind)) 'lambda)
665 (setcar (cdr bind) 'progn))
666 (if (stringp (car (cdr bind)))
667 (set keymap (cons (cdr bind) (symbol-value keymap)))
668 (set keymap (cons (vector (car bind) (cdr bind) t)
669 (symbol-value keymap))))))
670 bindlist)
671 (set keymap (cons name (symbol-value keymap)))))
672 (t
673 (mapcar
674 (function
675 (lambda (bind)
676 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
677 bindlist))))
679 (defvar yahtml-menu-map nil "Menu map of yahtml")
680 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")
681 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")
682 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")
683 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")
685 ;;; Variables for mosaic url history
686 (defvar yahtml-urls nil "Alist of global history")
687 (defvar yahtml-urls-private nil)
688 (defvar yahtml-urls-local nil)
690 (cond
691 ((and YaTeX-emacs-19 (null yahtml-menu-map))
692 (setq yahtml-menu-map (make-sparse-keymap "yahtml"))
693 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))
694 (YaTeX-define-menu
695 'yahtml-menu-map-sectioning
696 (nreverse
697 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))
698 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))
699 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))
700 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))
701 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))
702 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))
703 )))
704 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))
705 (YaTeX-define-menu
706 'yahtml-menu-map-logical
707 (nreverse
708 '((em "Embolden" .
709 (lambda () (interactive) (yahtml-insert-tag nil "EM")))
710 (dfn "Define a word" .
711 (lambda () (interactive) (yahtml-insert-tag nil "DFN")))
712 (cite "Citation" .
713 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))
714 (code "Code" .
715 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))
716 (kbd "Keyboard" .
717 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))
718 (samp "Sample display" .
719 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))
720 (strong "Strong" .
721 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))
722 (VAR "Variable notation" .
723 (lambda () (interactive) (yahtml-insert-tag nil "VAR")))
724 )))
725 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))
726 (YaTeX-define-menu
727 'yahtml-menu-map-typeface
728 (nreverse
729 '((b "Bold" .
730 (lambda () (interactive) (yahtml-insert-tag nil "B")))
731 (i "Italic" .
732 (lambda () (interactive) (yahtml-insert-tag nil "I")))
733 (tt "Typewriter" .
734 (lambda () (interactive) (yahtml-insert-tag nil "TT")))
735 (u "Underlined" .
736 (lambda () (interactive) (yahtml-insert-tag nil "U")))
737 )))
738 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))
739 (YaTeX-define-menu
740 'yahtml-menu-map-listing
741 (nreverse
742 '((ul "Unordered" .
743 (lambda () (interactive) (yahtml-insert-begend nil "UL")))
744 (ol "Ordered" .
745 (lambda () (interactive) (yahtml-insert-begend nil "OL")))
746 (dl "Definition" .
747 (lambda () (interactive) (yahtml-insert-begend nil "DL")))
748 )))
749 (setq yahtml-menu-map-item (make-sparse-keymap "item"))
750 (YaTeX-define-menu
751 'yahtml-menu-map-item
752 (nreverse
753 '((li "Simple item" .
754 (lambda () (interactive) (yahtml-insert-single "li")))
755 (dt "Define term" .
756 (lambda () (interactive) (yahtml-insert-single "dt")))
757 (dd "Description of term" .
758 (lambda () (interactive) (yahtml-insert-single "dd")))
759 )))
760 (define-key yahtml-mode-map [menu-bar yahtml]
761 (cons "yahtml" yahtml-menu-map))
762 (YaTeX-define-menu
763 'yahtml-menu-map
764 (nreverse
765 (list
766 (cons (list 'sect "Sectioning")
767 (cons "sectioning" yahtml-menu-map-sectioning))
768 (cons (list 'list "Listing")
769 (cons "Listing" yahtml-menu-map-listing))
770 (cons (list 'item "Item")
771 (cons "Itemizing" yahtml-menu-map-item));;;
772 (cons (list 'logi "Logical tags")
773 (cons "logical" yahtml-menu-map-logical))
774 (cons (list 'type "Typeface tags")
775 (cons "typeface" yahtml-menu-map-typeface))
776 )))
777 (if (featurep 'xemacs)
778 (add-hook 'yahtml-mode-hook
779 '(lambda ()
780 (or (assoc "yahtml" current-menubar)
781 (progn
782 (set-buffer-menubar (copy-sequence current-menubar))
783 (add-submenu nil yahtml-menu-map))))))
784 ))
786 ;;; ----------- Completion ----------
787 (defvar yahtml-last-begend "html")
788 (defun yahtml-insert-begend (&optional region env)
789 "Insert <cmd> ... </cmd>."
790 (interactive "P")
791 (setq yahtml-current-completion-type 'multiline)
792 (let*((completion-ignore-case t)
793 (cmd
794 (or env
795 (YaTeX-cplread-with-learning
796 (format "Environment(default %s): " yahtml-last-begend)
797 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))
798 (bolp (save-excursion
799 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))
800 (cc (current-column)))
801 (if (string< "" cmd) (setq yahtml-last-begend cmd))
802 (setq yahtml-last-begend
803 (or (cdr (assoc yahtml-last-begend yahtml-env-table))
804 yahtml-last-begend))
805 (setq cmd yahtml-last-begend)
806 (if yahtml-prefer-upcases (setq cmd (upcase cmd)))
807 (if region
808 ;; We want to keep region effective for new tagged environment
809 ;; to enable continuous regioning by another environment
810 (let ((beg (region-beginning))
811 (end (region-end))
812 (addin (yahtml-addin cmd)))
813 (save-excursion
814 (goto-char end)
815 (insert-before-markers (format "</%s>%s" cmd (if bolp "\n" "")))
816 (goto-char beg)
817 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" "")))))
818 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))
819 (save-excursion
820 (insert "\n")
821 (indent-to-column cc)
822 (insert (format "</%s>" cmd)))
823 (if (string-match "^a\\|p$" cmd) ;aとp決め打ちってのが美しくない…
824 (newline)
825 (yahtml-intelligent-newline nil))
826 (yahtml-indent-line))))
828 (defun yahtml-insert-begend-region ()
829 "Call yahtml-insert-begend in the region mode."
830 (interactive)
831 (yahtml-insert-begend t))
834 (defun yahtml-insert-form (&optional form)
835 "Insert <FORM option=\"argument\">."
836 (interactive)
837 (setq yahtml-current-completion-type 'single)
838 (or form
839 (let ((completion-ignore-case t))
840 (setq form
841 (YaTeX-cplread-with-learning
842 (format "Form(default %s): " yahtml-last-form)
843 'yahtml-form-table 'yahtml-user-form-table
844 'yahtml-tmp-form-table))))
845 (let ((p (point)) q)
846 (if (string= form "") (setq form yahtml-last-form))
847 (setq yahtml-last-form form)
848 (if yahtml-prefer-upcases (setq form (upcase form)))
849 (insert (format "<%s%s>" form (yahtml-addin form)))
850 ;;(indent-relative-maybe)
851 (if (cdr (assoc form yahtml-form-table))
852 (save-excursion (insert (format "</%s>" form))))
853 (if (search-backward "\"\"" p t) (forward-char 1))))
855 ;;; ---------- Add-in ----------
856 (defun yahtml-addin (form)
857 "Check add-in function's existence and call it if exists."
858 (let ((addin (concat "yahtml:" (downcase form))) s a)
859 (concat
860 (and (setq a (yahtml-css-get-element-completion-alist form))
861 (not (equal last-command-char ?\C-j))
862 (memq yahtml-current-completion-type '(multiline inline))
863 (yahtml-make-optional-argument ;should be made generic?
864 "class"
865 (let ((completion-ignore-case t))
866 (completing-read "class: " a))))
867 (if (and (intern-soft addin) (fboundp (intern-soft addin))
868 (stringp (setq s (funcall (intern addin))))
869 (string< "" s))
870 (if (eq (aref s 0) ? ) s (concat " " s))
871 ""))))
873 (defvar yahtml-completing-buffer nil)
874 (defun yahtml-collect-labels (&optional file)
875 "Collect current buffers label (<?? name=...>).
876 If optional argument FILE is specified collect labels in FILE."
877 (let (list end)
878 (save-excursion
879 (set-buffer yahtml-completing-buffer)
880 (if file (let (hilit-auto-highlight)
881 (set-buffer (find-file-noselect file))))
882 (save-excursion
883 (goto-char (point-min))
884 (while ;(re-search-forward "<\\w+\\b" nil t)
885 (re-search-forward "\\(name\\|id\\)\\s *=" nil t)
886 ;(setq bound (match-end 0))
887 ;(search-forward ">" nil t)
888 (setq end (match-end 0))
889 (if (and ;(re-search-backward "\\(name\\|id\\)\\s *=" bound t)
890 (yahtml-on-assignment-p)
891 (progn
892 (goto-char end)
893 (skip-chars-forward " \t\n")
894 (looking-at "\"?#?\\([^\">]+\\)\"?\\b")))
895 (setq list (cons
896 (list (concat "#" (YaTeX-match-string 1)))
897 list))))
898 list)))
899 )
901 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")
902 (if yahtml-url-completion-map nil
903 (setq yahtml-url-completion-map
904 (copy-keymap minibuffer-local-completion-map))
905 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)
906 (define-key yahtml-url-completion-map " " 'yahtml-complete-url)
907 )
909 (defun yahtml-complete-url ()
910 "Complete external URL from history or local file name."
911 (interactive)
912 (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels
913 (lim (YaTeX-minibuffer-begin))
914 (min (if (fboundp 'field-beginning) (field-beginning) (point-min))))
915 (setq initial (YaTeX-minibuffer-string))
916 (cond
917 ((string-match "^http:" initial)
918 (setq cmpl (try-completion initial yahtml-urls)
919 listfunc (list 'lambda nil
920 (list 'all-completions initial 'yahtml-urls))
921 beg min))
922 ((setq beg (string-match "#" initial))
923 (or (equal beg 0) ;begin with #
924 (progn
925 (setq path (substring initial 0 beg))
926 (if (string-match "^/" path)
927 (setq path (yahtml-url-to-path path)))))
928 (setq initial (substring initial beg))
929 (setq labels (yahtml-collect-labels path)
930 cmpl (try-completion initial labels)
931 listfunc (list 'lambda ()
932 (list 'all-completions
933 initial (list 'quote labels)))
934 beg (+ min beg)))
935 (t
936 (setq path (if (string-match "^/" initial)
937 (or (yahtml-url-to-path initial) initial)
938 initial))
939 (setq dir (or (file-name-directory path) ".")
940 file (file-name-nondirectory path)
941 initial file
942 cmpl (file-name-completion file dir)
943 listfunc (list 'lambda nil
944 (list 'file-name-all-completions
945 file dir))
946 beg (save-excursion (skip-chars-backward "^/" lim) (point)))))
947 (cond
948 ((stringp cmpl)
949 (if (string= initial cmpl)
950 (with-output-to-temp-buffer "*Completions*"
951 (princ "Possible completinos are:\n")
952 (princ
953 (mapconcat '(lambda (x) x) (funcall listfunc) "\n")))
954 (delete-region (point) beg)
955 (insert cmpl)))
956 ((null cmpl)
957 (ding))
958 ((eq t cmpl)
959 (save-excursion
960 (unwind-protect
961 (progn
962 (goto-char p)
963 (insert " [Sole completion]"))
964 (delete-region p (point-max))))))))
966 ;
967 ; Subject: [yatex:02849] Re: [yahtml] tilda in href tag
968 ; From: Masayasu Ishikawa <mimasa@sfc.keio.ac.jp>
969 ; To: yatex@arcadia.jaist.ac.jp
970 ; Date: Mon, 31 May 1999 21:09:31 +0900
971 ; RFC 2396 の "2.4.3. Excluded US-ASCII Characters" によると、以下の文字
972 ; は必ずエスケープしないといけません。
973 ;
974 ; control = <US-ASCII coded characters 00-1F and 7F hexadecimal>
975 ; space = <US-ASCII coded character 20 hexadecimal>
976 ; delims = "<" | ">" | "#" | "%" | <">
977 ; unwise = "{" | "}" | "|" | "\" | "^" | "[" | "]" | "`"
978 (defvar yahtml-unsafe-chars-regexp
979 "[][\x0- \x7f <>%\"{}|\\^`]" ;#は除去する
980 "Characters regexp which must be escaped in URI.")
981 ;
982 ; また、以下の文字は予約された用法以外に用いる場合にはエスケープしないと
983 ; いけないことになっています。
984 ;
985 ; reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" |
986 ; "$" | ","
987 (defvar yahtml-unreserved-chars-regexp
988 "[;/?:@&=+$,]"
989 "Characters regexp which should be escaped in URI on certain conditions.
990 Not used yet.")
992 (defun yahtml-escape-chars-string (str)
993 "Translate reserved chars to URL encoded string."
994 (let ((p 0) (target "")
995 (ask (eq yahtml-escape-chars 'ask)))
996 (cond
997 ((null yahtml-escape-chars) str)
998 (t
999 (while (and (string< "" str)
1000 (setq p (string-match yahtml-unsafe-chars-regexp str)))
1001 (if (and ask (y-or-n-p (format "Escape char [%c] of `%s'"
1002 (aref str p) (substring str 0 (1+ p)))))
1003 (setq target (concat target
1004 (substring str 0 p)
1005 (format "%%%x" (aref str p))))
1006 (setq target (concat target (substring str 0 (1+ p)))))
1007 (setq str (substring str (1+ p))))
1008 (concat target str)))))
1010 (defun yahtml-escape-chars-region (beg end)
1011 "Translate reserved chars to encoded string in the region."
1012 (interactive "r")
1013 (save-excursion
1014 (let ((e (set-marker (make-marker) end)) c m yes)
1015 (goto-char beg)
1016 (while (and (< (point) e)
1017 (re-search-forward
1018 (concat yahtml-unsafe-chars-regexp "\\|"
1019 yahtml-unreserved-chars-regexp) e t))
1020 (sit-for 0)
1021 ; (setq m (buffer-modified-p)
1022 ; c (char-after (1- (point))))
1023 ; (save-excursion (backward-char 1) (insert " ==>"))
1024 ; (unwind-protect
1025 ; (setq yes (y-or-n-p (format "Replace: [%c]" c)))
1026 ; (save-excursion
1027 ; (backward-char 1)
1028 ; (delete-backward-char 4))
1029 ; (set-buffer-modified-p m))
1030 (message "Replace: [%c] (y or n):" (setq c (char-after (1- (point)))))
1031 (if (memq (read-char) '(?y ?Y))
1032 (progn
1033 (delete-region (match-beginning 0) (match-end 0))
1034 (insert (format "%%%x" c)))))
1035 (set-marker e nil))))
1036 ;; ab%defgls/.|
1038 (defun yahtml:a ()
1039 "Add-in function for <a>"
1040 (let ((href ""))
1041 (setq yahtml-completing-buffer (current-buffer)
1042 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
1043 href (yahtml-escape-chars-string
1044 (read-from-minibuffer "href: " "" yahtml-url-completion-map)))
1045 (prog1
1046 (concat (yahtml-make-optional-argument
1047 "href" href)
1048 (yahtml-make-optional-argument
1049 "name" (read-string "name: ")))
1050 (if (and (string-match "^http://" href)
1051 (null (assoc href yahtml-urls-private))
1052 (null (assoc href yahtml-urls-local)))
1053 (YaTeX-update-table
1054 (list href)
1055 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))
1056 )))
1058 (defvar yahtml-parameters-completion-alist
1059 '(("align" ("top") ("middle") ("bottom") ("left") ("right") ("center"))
1060 ("clear" ("left") ("right") ("center") ("all") ("none"))
1061 ("src" . file)
1062 ("background" . file)
1063 ("class file name" . file) ("data" . file)
1064 ("method" ("POST") ("GET"))
1065 ("rev" . yahtml-link-types-alist)
1066 ("rel" . yahtml-link-types-alist)
1067 ("type" . yahtml-content-types-alist)
1068 ("codetype" . yahtml-content-types-alist)
1069 ("http-equiv" ("Refresh"))))
1071 (defvar yahtml-link-types-alist
1072 '(("alternate") ("stylesheet") ("start") ("next") ("prev")
1073 ("contents") ("index") ("glossary") ("chapter") ("section")
1074 ("subsection") ("appendix") ("help") ("bookmark")))
1076 (defvar yahtml-content-types-alist
1077 '(("text/css") ("text/html") ("text/plain") ("text/richtext")
1078 ("text/sgml") ("text/xml")
1079 ("application/octet-stream") ("application/postscript") ("application/pdf")
1080 ("application/java")
1081 ("image/jpeg") ("image/gif") ("image/tiff") ("image/png") ("video/mpeg"))
1082 "Alist of content-types")
1084 (defun yahtml-read-parameter (par &optional default alist)
1085 (let* ((alist
1086 (cdr-safe (assoc (downcase par)
1087 (or alist yahtml-parameters-completion-alist))))
1088 (prompt (concat par ": "))
1089 v)
1090 (cond
1091 ((eq alist 'file)
1092 (read-file-name prompt "" default nil ""))
1093 ((and alist (symbolp alist))
1094 (completing-read prompt (symbol-value alist) nil nil default))
1095 (alist
1096 (completing-read prompt alist nil nil default))
1097 (t
1098 (read-string prompt default)))))
1100 (defun yahtml-make-optional-argument (opt arg)
1101 "Make optional argument string."
1102 (if (string= "" arg)
1103 ""
1104 (concat " "
1105 (if yahtml-prefer-upcase-attributes (upcase opt) (downcase opt))
1106 "=\"" arg "\"")))
1108 (defun yahtml:body ()
1109 "Add-in function for <body>"
1110 (let ((b (read-string "bgcolor="))
1111 (bg (yahtml-read-parameter "background" ""))
1112 (x (read-string "text color="))
1113 (l (read-string "link color="))
1114 (v (read-string "vlink color=")))
1115 (concat
1116 (yahtml-make-optional-argument "bgcolor" b)
1117 (yahtml-make-optional-argument "background" bg)
1118 (yahtml-make-optional-argument "text" x)
1119 (yahtml-make-optional-argument "link" l)
1120 (yahtml-make-optional-argument "vlink" v))))
1122 (defun yahtml:img ()
1123 "Add-in function for <img>"
1124 (let ((src (yahtml-read-parameter "src"))
1125 (alg (yahtml-read-parameter "align"))
1126 alt
1127 (brd (read-string "border="))
1128 (l yahtml-prefer-upcase-attributes)
1129 info width height bytes comments)
1130 (and (stringp src) (string< "" src) (file-exists-p src)
1131 (setq info (yahtml-get-image-info src))
1132 (car info)
1133 (setq width (int-to-string (car info))
1134 height (int-to-string (car (cdr info)))
1135 bytes (car (cdr (cdr info)))
1136 comments (nth 4 info)))
1137 (if info
1138 (setq alt
1139 (YaTeX-replace-formats
1140 yahtml:img-default-alt-format
1141 (list (cons "x" width)
1142 (cons "y" height)
1143 (cons "s" (int-to-string bytes))
1144 (cons "f" (file-name-nondirectory src))
1145 (cons "c" (car comments))))))
1147 (setq alt (yahtml-read-parameter "alt" alt))
1148 (setq width (yahtml-read-parameter "width" width)
1149 height (yahtml-read-parameter "height" height))
1150 (concat (if l "SRC" "src") "=\"" src "\""
1151 (yahtml-make-optional-argument "align" alg)
1152 (yahtml-make-optional-argument "alt" alt)
1153 (yahtml-make-optional-argument "width" width)
1154 (yahtml-make-optional-argument "height" height)
1155 (yahtml-make-optional-argument "border" brd))))
1157 (defun yahtml-file-truename (file)
1158 (cond
1159 ((fboundp 'file-truename) (file-truename (expand-file-name file)))
1160 (t (let ((new file))
1161 (while (and (stringp (setq new (nth 0 (file-attributes file))))
1162 (not (equal new file)))
1163 (setq file new))
1164 file))))
1166 (defun yahtml-hex-value (point length &optional little-endian)
1167 "Return the hex value the POINT positions LENGTH byte stream represents.
1168 Optional third argument LITTLE-ENDIAN is self extplanatory."
1169 (setq point (1+ point)) ;translate file offset to Emacs's point value
1170 (let ((mlt 1)
1171 (pos (if little-endian point (+ point length -1)))
1172 (direc (if little-endian 1 -1))
1173 (value 0))
1174 (while (> length 0)
1175 (setq value (+ value (* mlt (char-after pos)))
1176 pos (+ pos direc)
1177 mlt (* mlt 256)
1178 length (1- length)))
1179 value))
1181 (defun yahtml-get-image-info (file)
1182 "Return the information on the image file FILE.
1183 Returns list of '(WIDTH HEIGHT BYTES DEPTH COMMENTLIST)."
1184 (save-excursion
1185 (let*((tmpbuf (get-buffer-create " *imgheader*"))
1186 width height bytes depth comment
1187 (file-coding-system-alist (list (cons "." 'no-conversion))) ;20
1188 (file-coding-system-for-read (and (boundp '*noconv*) *noconv*)) ;19
1189 (coding-system-for-read 'no-conversion)
1190 (seekpoint 1)
1191 c1 c2 c3 c4 beg end
1192 (case-fold-search nil))
1193 (setq bytes (nth 7 (file-attributes (yahtml-file-truename file))))
1194 (set-buffer tmpbuf)
1195 (if (boundp 'mc-flag) (set (make-local-variable 'mc-flag) nil))
1196 (erase-buffer)
1197 (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))
1198 (unwind-protect
1199 (progn
1200 (message "Inspecting image information of %s..." file)
1201 ;; Read 4bytes-more than inspection-bytes in case that
1202 ;; JPEG marker delimiter (4bytes) is on the alignment.
1203 (YaTeX-insert-file-contents
1204 file nil 0 (+ yahtml-image-inspection-bytes 4))
1205 (goto-char (point-min)) ;assertion
1206 (setq c1 (char-after 1) ;cache first 4 bytes
1207 c2 (char-after 2)
1208 c3 (char-after 3)
1209 c4 (char-after 4))
1210 (cond
1211 ((and (eq c1 ?\377) (eq c2 ?\330)) ; 0xff 0xd8
1212 ;;JPEG images need JPEG markers inspection
1213 ;;JPEG markers consist of [ 0xff ID(B) LEN(S) CONTENTS... ]
1214 ;; Warning: here seekpoint is measured by Emacs's point value
1215 ;; while yahtml-hex-vale requires file offset
1216 (setq seekpoint 3) ;where the first JPEG marker exists
1217 (catch 'exit
1218 (while (< seekpoint (- (buffer-size) 4))
1219 (cond
1220 ((not (eq (char-after seekpoint) ?\377))
1221 ;maybe corrupted, exit from loop
1222 (throw 'exit t))
1223 ((memq
1224 (char-after (1+ seekpoint))
1225 '(?\300 ?\301 ?\302 ?\303
1226 ?\305 ?\306 ?\307 ?\311 ?\312 ?\313 ?\315 ?\316 ?\317))
1227 ;;'(192 193 194 195 197 198 199 201 202 203 205 206 207
1228 ;;found!
1229 (setq height (yahtml-hex-value (+ seekpoint 4) 2)
1230 width (yahtml-hex-value (+ seekpoint 6) 2)
1231 depth (yahtml-hex-value (+ seekpoint 3) 1)))
1232 ((eq (char-after (1+ seekpoint)) ?\376) ;0xFE = comment
1233 ;; JPEG comment area
1234 (setq beg (+ seekpoint 2 2)
1235 end (+ seekpoint
1236 (yahtml-hex-value (1+ seekpoint) 2) 2))
1237 (setq comment (cons (buffer-substring beg end) comment)))
1238 (t ;other markers
1239 nil)) ;just skip it
1240 (setq seekpoint (+ seekpoint 2)
1241 seekpoint (+ seekpoint
1242 (yahtml-hex-value (1- seekpoint) 2))))))
1243 ((and (eq c1 ?\211) ;0x89
1244 (eq c2 ?P) (eq c3 ?N) (eq c4 ?G))
1245 ;;PNG Image data X=@0x10(L), Y=@0x14(L), D=@0x18(B)
1246 (setq width (yahtml-hex-value 16 4)
1247 height (yahtml-hex-value 20 4)
1248 depth (yahtml-hex-value 24 1)))
1249 ((looking-at "GIF8")
1250 ;;GIF Image data X=@0x6(leshort), Y=@0x8(leshort)
1251 (setq width (yahtml-hex-value 6 2 t)
1252 height (yahtml-hex-value 8 2 t)))
1253 ((looking-at "BM")
1254 ;;# OS/2, Windoze BMP files
1255 ;;@0x0e = 12 -> OS/2 1.x - X=@0x12(leshort), Y=@0x14(leshort)
1256 ;;@0x0e = 64 -> OS/2 2.x - X=@0x12(leshort), Y=@0x14(leshort)
1257 ;;@0x0e = 40 -> Windows 3.x - X=@0x12(lelong), Y=@0x16(lelong)
1258 (cond
1259 ((eq (yahtml-hex-value 14 2 t) 40)
1260 (setq width (yahtml-hex-value 18 4 t)
1261 height (yahtml-hex-value 22 4 t)))
1262 (t
1263 (setq width (yahtml-hex-value 18 2 t)
1264 height (yahtml-hex-value 20 2 t)))))
1265 ))
1266 (message "")
1267 (kill-buffer tmpbuf))
1268 (list width height bytes depth (nreverse comment)))))
1270 (defun yahtml:form ()
1271 "Add-in function `form' input format"
1272 (concat
1273 " " (if yahtml-prefer-upcase-attributes "METHOD" "method") "="
1274 (completing-read "Method: " '(("POST") ("GET")) nil t)
1275 " " (if yahtml-prefer-upcase-attributes "ACTION" "action") "=\""
1276 (read-string "Action: ") "\""
1277 ))
1279 (defun yahtml:select ()
1280 "Add-in function for `select' input format"
1281 (setq yahtml-last-single-cmd "option")
1282 (concat " " (if yahtml-prefer-upcase-attributes "NAME" "name") "=\""
1283 (read-string "name: ") "\""))
1285 (defun yahtml:ol ()
1286 "Add-in function for <ol>"
1287 (setq yahtml-last-single-cmd "li")
1288 (let ((start (read-string "start="))
1289 (type (completing-read
1290 "type=" '(("1") ("a") ("A") ("i") ("I")) nil t)))
1291 (concat
1292 (yahtml-make-optional-argument "start" start)
1293 (yahtml-make-optional-argument "type" type))))
1294 (defun yahtml:ul ()
1295 (setq yahtml-last-single-cmd "li") "")
1296 (defun yahtml:dl ()
1297 (setq yahtml-last-single-cmd "dt") "")
1298 (defun yahtml:dt ()
1299 (setq yahtml-last-single-cmd "dd") "")
1301 (defun yahtml:p ()
1302 (let ((alg (yahtml-read-parameter "align")))
1303 (yahtml-make-optional-argument "align" alg)
1304 ))
1306 (defvar yahtml-input-types
1307 '(("text") ("password") ("checkbox") ("radio") ("submit")
1308 ("reset") ("image") ("hidden") ("file")))
1310 (defun yahtml:input ()
1311 "Add-in function for `input' form"
1312 (let ((size "") name type value checked (maxlength "")
1313 (l yahtml-prefer-upcase-attributes))
1314 (setq name (read-string "name: ")
1315 type (completing-read "type (default=text): "
1316 yahtml-input-types nil t)
1317 value (read-string "value: "))
1318 (if (string-match "text\\|password\\|^$" type)
1319 (setq size (read-string "size: ")
1320 maxlength (read-string "maxlength: ")))
1321 (concat
1322 (if l "NAME" "name") "=\"" name "\""
1323 (yahtml-make-optional-argument "type" type)
1324 (yahtml-make-optional-argument "value" value)
1325 (yahtml-make-optional-argument "size" size)
1326 (yahtml-make-optional-argument "maxlength" maxlength)
1327 )))
1329 (defun yahtml:textarea ()
1330 "Add-in function for `textarea'"
1331 (interactive)
1332 (let (name rows cols)
1333 (setq name (read-string "Name: ")
1334 cols (read-string "Columns: ")
1335 rows (read-string "Rows: "))
1336 (concat
1337 (concat (if yahtml-prefer-upcase-attributes "NAME=" "name=")
1338 "\"" name "\"")
1339 (yahtml-make-optional-argument "cols" cols)
1340 (yahtml-make-optional-argument "rows" rows))))
1342 (defun yahtml:table ()
1343 "Add-in function for `table'"
1344 (let ((b (read-string "border="))
1345 (a (yahtml-read-parameter "align")))
1346 (concat
1347 (yahtml-make-optional-argument "border" b)
1348 (yahtml-make-optional-argument "align" a))))
1349 ;(fset 'yahtml:caption 'yahtml:p)
1350 (defun yahtml:caption ()
1351 "Add-in function for `caption' in table tag"
1352 (let ((yahtml-parameters-completion-alist '(("align" ("top") ("bottom")))))
1353 (yahtml-make-optional-argument "align" (yahtml-read-parameter "align"))))
1355 (defun yahtml:font ()
1356 "Add-in function for `font'"
1357 (concat
1358 (yahtml-make-optional-argument "color" (read-string "color="))
1359 (yahtml-make-optional-argument "size" (read-string "size="))))
1361 (defun yahtml:style ()
1362 "Add-in function for `style'"
1363 (yahtml-make-optional-argument
1364 "type" (read-string "type=" "text/css")))
1366 (defun yahtml:tr ()
1367 "Add-in function for `tr'"
1368 (setq ;yahtml-last-begend "td" ;; which do you prefer?
1369 yahtml-last-typeface-cmd "td")
1370 "")
1372 (defun yahtml:link ()
1373 "Add-in function for `link' (まだちょっと良く分かってない)"
1374 (let (rel rev type href)
1375 (setq rel (yahtml-read-parameter "rel"))
1376 (cond
1377 ((equal rel "")
1378 (concat (yahtml-make-optional-argument
1379 "rev" (yahtml-read-parameter "rev"))
1380 (yahtml-make-optional-argument
1381 "href" (yahtml-read-parameter "href")
1382 ;;他に良く使うのって何?
1383 )))
1384 ((string-match "stylesheet" rel)
1385 (concat
1386 (yahtml-make-optional-argument "rel" rel)
1387 (yahtml-make-optional-argument
1388 "type" (yahtml-read-parameter "type" "text/css"))
1389 (progn
1390 (setq href
1391 (read-from-minibuffer "href: " "" yahtml-url-completion-map))
1392 (if (string< "" href)
1393 (progn
1394 (if (and (file-exists-p (yahtml-url-to-path href))
1395 (y-or-n-p "Load css symbols now? "))
1396 (setq yahtml-css-class-alist
1397 (yahtml-css-collect-classes-file
1398 (yahtml-url-to-path href) yahtml-css-class-alist)))
1399 (message "")
1400 (yahtml-make-optional-argument "href" href))))))
1401 (t ;;??
1402 ))))
1404 (defvar yahtml:meta-names
1405 '(("name" ("keywords")("author")("copyright")("date")("GENERATOR"))))
1407 (defun yahtml:meta ()
1408 (let ((name (yahtml-make-optional-argument
1409 "name"
1410 (yahtml-read-parameter "name" nil yahtml:meta-names)))
1411 http-equiv content)
1412 (if (string= "" name)
1413 (if (string-match
1414 "Content-type"
1415 (setq http-equiv (yahtml-make-optional-argument
1416 "http-equiv"
1417 (yahtml-read-parameter "http-equiv" nil))))
1418 (error "It's very bad idea to set Content-type in META. %s"
1419 "See docs/qanda")
1420 (concat http-equiv
1421 (yahtml-make-optional-argument
1422 "content" (yahtml-read-parameter "content"))))
1423 (concat
1424 name
1425 (yahtml-make-optional-argument
1426 "content"
1427 (cond
1428 ((string-match "date" name)
1429 (read-string "Date: " (current-time-string)))
1430 ((string-match "author" name)
1431 (read-string "Author: "
1432 (if (and (user-full-name) (string< "" (user-full-name)))
1433 (user-full-name)
1434 (user-login-name))))
1435 ((string-match "GENERATOR" name)
1436 (setq content (read-string "Generator: " "User-agent: "))
1437 (if (string-match "yahtml" content)
1438 (message "Thank you!"))
1439 content)
1440 (t (read-string (concat name ": ")))))))))
1442 (defun yahtml:br ()
1443 (yahtml-make-optional-argument "clear" (yahtml-read-parameter "clear")))
1445 (defun yahtml:object ()
1446 (let ((codetype (yahtml-read-parameter "codetype" "application/java"))
1447 data classid)
1448 (cond
1449 ((string-match "java" codetype)
1450 (let ((completion-ignored-extensions
1451 ;;any extensions except ".class"
1452 '(".java" ".html" ".htm" ".gif" ".jpg" ".jpeg" ".png")))
1453 (setq classid (concat "java:"
1454 (yahtml-read-parameter "class file name"))))
1455 (concat
1456 (yahtml-make-optional-argument "codetype" codetype)
1457 (yahtml-make-optional-argument "classid" classid)
1458 (yahtml-make-optional-argument
1459 "width" (yahtml-read-parameter "width"))
1460 (yahtml-make-optional-argument
1461 "height" (yahtml-read-parameter "height"))
1462 (yahtml-make-optional-argument
1463 "align" (yahtml-read-parameter "align"))
1464 ))
1465 (t
1466 ""
1467 ))))
1469 ;;; ---------- Simple tag ----------
1470 (defun yahtml-insert-tag (region-mode &optional tag)
1471 "Insert <TAG> </TAG> and put cursor inside of them."
1472 (interactive "P")
1473 (setq yahtml-current-completion-type 'inline)
1474 (or tag
1475 (let ((completion-ignore-case t))
1476 (setq tag
1477 (YaTeX-cplread-with-learning
1478 (format "Tag %s(default %s): "
1479 (if region-mode "region: " "") yahtml-last-typeface-cmd)
1480 'yahtml-typeface-table 'yahtml-user-typeface-table
1481 'yahtml-tmp-typeface-table))))
1482 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))
1483 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))
1484 (setq yahtml-last-typeface-cmd tag
1485 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))
1486 (if region-mode
1487 (if (if (string< "19" emacs-version) (mark t) (mark))
1488 (save-excursion
1489 (if (> (point) (mark)) (exchange-point-and-mark))
1490 (insert (format "<%s%s>" tag (yahtml-addin tag)))
1491 (exchange-point-and-mark)
1492 (insert "</" tag ">"))
1493 (message "No mark set now"))
1494 (insert (format "<%s%s>" tag (yahtml-addin tag)))
1495 (save-excursion (insert (format "</%s>" tag)))))
1497 (defun yahtml-insert-tag-region (&optional tag)
1498 "Call yahtml-insert-tag with region mode."
1499 (interactive)
1500 (yahtml-insert-tag t tag))
1503 (defun yahtml-insert-single (cmd)
1504 "Insert <CMD>."
1505 (interactive
1506 (list
1507 (let ((completion-ignore-case t))
1508 (YaTeX-cplread-with-learning
1509 (format "Command%s: "
1510 (if yahtml-last-single-cmd
1511 (concat "(default " yahtml-last-single-cmd ")") ""))
1512 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table
1513 'yahtml-tmp-single-cmd-table))))
1514 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))
1515 (setq yahtml-last-single-cmd
1516 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))
1517 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
1518 yahtml-last-single-cmd))
1519 (insert (format "<%s>" cmd)))
1521 (defun yahtml-insert-p (&optional arg)
1522 "Convenient function to insert <p></p>"
1523 (interactive "P")
1524 (if arg (yahtml-insert-tag arg "p")
1525 (save-excursion ;insert "/p" first to memorize "p"
1526 (yahtml-insert-single "/p")) ;in the last-completion variable
1527 (yahtml-insert-single "p")))
1529 (defun yahtml-insert-amps (arg)
1530 "Insert char-entity references via ampersand"
1531 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/
1532 (interactive "P")
1533 (let*((mess "") c
1534 (list (append yahtml-entity-reference-chars-alist-default
1535 yahtml-entity-reference-chars-alist))
1536 (l list))
1537 (while l
1538 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))
1539 l (cdr l)))
1540 (message "Char-entity reference: %s SPC=& RET=&; Other=&#..;" mess)
1541 (setq c (read-char))
1542 (cond
1543 ((equal c (car-safe (assoc c list)))
1544 (insert (format "&%s;" (cdr (assoc c list)))))
1545 ((or (equal c ?\n) (equal c ?\r))
1546 (insert "&;")
1547 (forward-char -1))
1548 ((equal c ? )
1549 (insert ?&))
1550 (t (insert (format "&#%d;" c))))))
1552 ;;; ---------- Jump ----------
1553 (defun yahtml-on-href-p ()
1554 "Check if point is on href clause."
1555 (let ((p (point)) e cmd (case-fold-search t))
1556 (save-excursion
1557 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした
1558 (save-excursion
1559 ;;(search-forward "</a>" nil t) ;aでなくても許可にした
1560 (search-forward "[\" \t\n]" nil t)
1561 (setq e (point)))
1562 ;(goto-char (get 'YaTeX-inner-environment 'point))
1563 (re-search-backward "<\\(a\\|link\\)\\>" nil t)
1564 (search-forward "href" e t)
1565 (search-forward "=" e t)
1566 (progn
1567 (skip-chars-forward " \t\n")
1568 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
1569 (< p (match-end 0))
1570 (YaTeX-match-string 1)
1571 ))))
1573 (defun yahtml-netscape-sentinel (proc mes)
1574 (cond
1575 ((null (buffer-name (process-buffer proc)))
1576 (set-process-buffer proc nil))
1577 ((eq (process-status proc) 'exit)
1578 (let ((cb (current-buffer)))
1579 (set-buffer (process-buffer proc))
1580 (goto-char (point-min))
1581 (if (search-forward "not running" nil t)
1582 (progn
1583 (message "Starting netscape...")
1584 (start-process
1585 "browser" (process-buffer proc)
1586 shell-file-name yahtml-shell-command-option
1587 (format "%s \"%s\"" yahtml-www-browser
1588 (get 'yahtml-netscape-sentinel 'url)))
1589 (message "Starting netscape...Done")))
1590 (set-buffer cb)))))
1592 (defvar yahtml-browser-process nil)
1594 (defun yahtml-browse-html (href)
1595 "Call WWW Browser to see HREF."
1596 (let ((pb "* WWW Browser *") (cb (current-buffer)))
1597 (cond
1598 ((string-match "^start\\>" yahtml-www-browser)
1599 (if (get-buffer pb)
1600 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1601 (put 'yahtml-netscape-sentinel 'url href)
1602 (set-process-sentinel
1603 (setq yahtml-browser-process
1604 (start-process
1605 "browser" pb shell-file-name yahtml-shell-command-option
1606 (format "%s \"%s\"" yahtml-www-browser href)))
1607 'yahtml-netscape-sentinel))
1608 ((and (string-match "[Nn]etscape" yahtml-www-browser)
1609 (not (eq system-type 'windows-nt)))
1610 (if (get-buffer pb)
1611 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1612 (put 'yahtml-netscape-sentinel 'url href)
1613 (set-process-sentinel
1614 (setq yahtml-browser-process
1615 (start-process
1616 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
1617 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))
1618 'yahtml-netscape-sentinel))
1619 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))
1620 (w3-fetch href))
1621 ((stringp yahtml-www-browser)
1622 (if (and yahtml-browser-process
1623 (eq (process-status yahtml-browser-process) 'run))
1624 (message "%s is already running" yahtml-www-browser)
1625 (setq yahtml-browser-process
1626 (start-process
1627 "browser" "* WWW Browser *"
1628 shell-file-name yahtml-shell-command-option
1629 (format "%s \"%s\"" yahtml-www-browser href)))))
1630 (t
1631 (message "Sorry, jump across http is not supported.")))))
1633 (defun yahtml-goto-corresponding-href (&optional other)
1634 "Go to corresponding name."
1635 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))
1636 (if href
1637 (cond
1638 ((string-match "^\\(ht\\|f\\)tp:" href)
1639 (yahtml-browse-html href))
1640 (t (setq file (substring href 0 (string-match "#" href)))
1641 (if (string-match "#" href)
1642 (setq name (substring href (1+ (string-match "#" href)))))
1643 (if (string< "" file)
1644 (progn
1645 (if (string-match "/$" file)
1646 (or (catch 'dirindex
1647 (mapcar
1648 (function
1649 (lambda (f)
1650 (if (file-exists-p (concat file f))
1651 (throw 'dirindex
1652 (setq file (concat file f))))))
1653 (yahtml-get-directory-index))
1654 nil)
1655 (setq file (concat file yahtml-directory-index))))
1656 (if (string-match "^/" file)
1657 (setq file (yahtml-url-to-path file)))
1658 (if other (YaTeX-switch-to-buffer-other-window file)
1659 (YaTeX-switch-to-buffer file))
1660 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))
1661 (if name
1662 (progn (set-mark-command nil) (yahtml-jump-to-name name)))
1663 t)))))
1665 (defun yahtml-jump-to-name (name)
1666 "Jump to html's named tag."
1667 (setq name (format "\\(name\\|id\\)\\s *=\\s *\"?%s\\>\"?" name))
1668 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))
1669 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))
1670 (message "Named tag `%s' not found" (substring href 1))))
1672 (defun yahtml-on-begend-p (&optional p)
1673 "Check if point is on begend clause."
1674 (let ((p (or p (point))) cmd (case-fold-search t))
1675 (save-excursion
1676 (goto-char p)
1677 (if (equal (char-after (point)) ?<) (forward-char 1))
1678 (if (and (re-search-backward "<" nil t)
1679 (looking-at
1680 ;(concat "<\\(/?" yahtml-struct-name-regexp "\\)\\b")
1681 "<\\(/?[A-Z][A-Z0-9]*\\)\\b"
1682 )
1683 (condition-case nil
1684 (forward-list 1)
1685 (error nil))
1686 (< p (point)))
1687 (YaTeX-match-string 1)))))
1689 (defun yahtml-goto-corresponding-begend (&optional noerr)
1690 "Go to corresponding opening/closing tag.
1691 Optional argument NOERR causes no error for unballanced tag."
1692 (let ((cmd (yahtml-on-begend-p)) m0
1693 (p (point)) (case-fold-search t) func str (nest 0))
1694 (cond
1695 (cmd
1696 (setq m0 (match-beginning 0))
1697 (if (= (aref cmd 0) ?/) ;on </cmd> line
1698 (setq cmd (substring cmd 1)
1699 str (format "\\(<%s\\)\\|\\(</%s\\)" cmd cmd)
1700 func 're-search-backward)
1701 (setq str (format "\\(</%s\\)\\|\\(<%s\\)" cmd cmd)
1702 func 're-search-forward))
1703 (while (and (>= nest 0) (funcall func str nil t))
1704 (if (equal m0 (match-beginning 0))
1705 nil
1706 (setq nest (+ nest (if (match-beginning 1) -1 1)))))
1707 (if (< nest 0)
1708 (goto-char (match-beginning 0))
1709 (funcall
1710 (if noerr 'message 'error)
1711 "Corresponding tag of `%s' not found." cmd)
1712 (goto-char p)
1713 nil))
1714 (t nil))))
1716 (defun yahtml-current-tag ()
1717 "Return the current tag name."
1718 (save-excursion
1719 (let ((p (point)) b tag)
1720 (or (bobp)
1721 (looking-at "<")
1722 (progn (skip-chars-backward "^<") (forward-char -1)))
1723 (setq b (point))
1724 (skip-chars-forward "<")
1725 (setq tag (buffer-substring
1726 (point) (progn (skip-chars-forward "^ \t\n") (point))))
1727 (goto-char b)
1728 (forward-list 1)
1729 (and (< p (point)) tag))))
1732 (defun yahtml-goto-corresponding-img ()
1733 "View image on point"
1734 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))
1735 (if (and tag
1736 (string-match "img" tag)
1737 (save-excursion
1738 (re-search-backward "<\\s *img" nil t)
1739 (re-search-forward "src=\"?\\([^\"> ]+\\)\"?")
1740 (match-beginning 1)
1741 (setq image
1742 (buffer-substring (match-beginning 1) (match-end 1)))))
1743 (progn
1744 (message "Invoking %s %s..." yahtml-image-viewer image)
1745 (start-process
1746 "Viewer" " * Image Viewer *"
1747 shell-file-name yahtml-shell-command-option ;"-c"
1748 (concat yahtml-image-viewer " " image))
1749 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))
1751 (defun yahtml-get-attrvalue (attr)
1752 "Extract current tag's attribute value from buffer."
1753 (let (e (case-fold-search t))
1754 (save-excursion
1755 (or (looking-at "<")
1756 (progn (skip-chars-backward "^<") (backward-char 1)))
1757 (setq e (save-excursion (forward-list 1) (point)))
1758 (if (and
1759 (re-search-forward (concat "\\b" attr "\\b") e t)
1760 (progn (skip-chars-forward " \t\n=")
1761 (looking-at "\"?\\([^\"> \t\n]+\\)\"?")))
1762 (YaTeX-match-string 1)))))
1764 (defun yahtml-goto-corresponding-source (&optional other)
1765 "Goto applet's source."
1766 (let ((env (yahtml-current-tag)) s (p (point)))
1767 (cond
1768 ((string-match "applet" env)
1769 (if (setq s (yahtml-get-attrvalue "code"))
1770 (progn
1771 (setq s (YaTeX-match-string 1)
1772 s (concat
1773 (substring s 0 (string-match "\\.[A-Za-z]+$" s))
1774 ".java"))
1775 (if other (YaTeX-switch-to-buffer-other-window s)
1776 (YaTeX-switch-to-buffer s))
1777 s) ;return source file name
1778 (message "No applet source specified")
1779 (sit-for 1)
1780 nil))
1781 ((string-match "!--#include" env)
1782 (cond
1783 ((setq s (yahtml-get-attrvalue "file")) ;<!--#include file="foo"-->
1784 (if other (YaTeX-switch-to-buffer-other-window s)
1785 (YaTeX-switch-to-buffer s))
1786 s)
1787 ((setq s (yahtml-get-attrvalue "virtual"));<!--#include virtual="foo"-->
1788 (setq s (yahtml-url-to-path s))
1789 (if other (YaTeX-switch-to-buffer-other-window s)
1790 (YaTeX-switch-to-buffer s))
1791 s)))
1792 ((and (string-match "!--#exec" env)
1793 (setq s (yahtml-get-attrvalue "cmd")))
1794 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0
1795 (let ((b " *yahtmltmp*")) ;peek a little
1796 (unwind-protect
1797 (progn
1798 (set-buffer (get-buffer-create b))
1799 (YaTeX-insert-file-contents s nil 0 100)
1800 (if (looking-at "#!")
1801 (if other (YaTeX-switch-to-buffer-other-window s)
1802 (YaTeX-switch-to-buffer s))))
1803 (kill-buffer (get-buffer b)))
1804 (get-file-buffer s))))))
1806 (defun yahtml-goto-corresponding-* (&optional other)
1807 "Go to corresponding object."
1808 (interactive)
1809 (cond
1810 ((yahtml-goto-corresponding-href other))
1811 ((yahtml-goto-corresponding-img))
1812 ((yahtml-goto-corresponding-begend))
1813 ((yahtml-goto-corresponding-source other))
1814 (t (message "I don't know where to go."))
1815 ))
1817 (defun yahtml-goto-corresponding-*-other-window ()
1818 "Go to corresponding object."
1819 (interactive)
1820 (yahtml-goto-corresponding-* t))
1822 (defun yahtml-visit-main ()
1823 "Go to parent file from where you visit current file."
1824 (interactive)
1825 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))
1827 ;;; ---------- killing ----------
1828 (defun yahtml-kill-begend (&optional whole)
1829 (let ((tag (yahtml-on-begend-p)) p q r bbolp)
1830 (if tag
1831 (save-excursion
1832 (or (looking-at "<")
1833 (progn (skip-chars-backward "^<") (forward-char -1)))
1834 (setq p (point))
1835 (yahtml-goto-corresponding-begend)
1836 (or (looking-at "<")
1837 (progn (skip-chars-backward "^<") (forward-char -1)))
1838 (if (< (point) p) ;if on the opening tag
1839 (progn (setq q p p (point))
1840 (goto-char q))
1841 (setq q (point))) ;now q has end-line's (point)
1842 (if (not whole)
1843 (kill-region
1844 (progn (skip-chars-backward " \t")
1845 (if (setq bbolp (bolp)) (point) q))
1846 (progn (forward-list 1)
1847 (setq r (point))
1848 (skip-chars-forward " \t")
1849 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))
1850 (goto-char p)
1851 (skip-chars-backward " \t")
1852 (if (not whole)
1853 (progn
1854 (kill-append
1855 (buffer-substring
1856 (setq p (if (setq bbolp (bolp)) (point) p))
1857 (setq q (progn
1858 (forward-list 1)
1859 (setq r (point))
1860 (skip-chars-forward " \t")
1861 (if (and bbolp (eolp) (not (eobp)))
1862 (1+ (point))
1863 r))))
1864 t)
1865 (delete-region p q))
1866 (kill-region
1867 (if (bolp) (point) p)
1868 (progn (goto-char q)
1869 (forward-list 1)
1870 (setq r (point))
1871 (skip-chars-forward " \t")
1872 (if (and (eolp) (not (eobp))) (1+ (point)) r))))
1873 tag))))
1875 (defun yahtml-kill-* (whole)
1876 "Kill current position's HTML tag (set)."
1877 (interactive "P")
1878 (cond
1879 ((yahtml-kill-begend whole))
1880 ))
1883 ;;; ---------- changing ----------
1884 (defun yahtml-on-assignment-p ()
1885 "Return if current point is on parameter assignment.
1886 If so, return parameter name, otherwise nil.
1887 This function should be able to treat white spaces in value, but not yet."
1888 (let ((p (point)))
1889 (save-excursion
1890 (put 'yahtml-on-assignment-p 'region nil)
1891 (skip-chars-backward "^ \t\n")
1892 (and (looking-at "\\([A-Za-z0-9]+\\)\\s *=\\s *\"?\\([^ \t\"]+\\)\"?")
1893 (< p (match-end 0))
1894 (>= p (1- (match-beginning 2)))
1895 (put 'yahtml-on-assignment-p 'region
1896 (cons (match-beginning 2) (match-end 2)))
1897 (YaTeX-match-string 1)))))
1899 (defun yahtml-change-begend ()
1900 (let ((tag (yahtml-on-begend-p))
1901 (completion-ignore-case t)
1902 (case-fold-search t)
1903 (p (point)) (q (make-marker))
1904 (default (append yahtml-env-table yahtml-typeface-table))
1905 (user (append yahtml-user-env-table yahtml-user-typeface-table))
1906 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))
1907 href b1 e1 attr new css)
1908 (cond
1909 (tag
1910 (cond
1911 ((and (string-match "^a$" tag)
1912 (save-excursion
1913 (and
1914 (re-search-backward "<a\\b" nil t)
1915 (progn
1916 (goto-char (match-end 0))
1917 (skip-chars-forward " \t\n")
1918 (setq b1 (point))
1919 (search-forward ">" nil t))
1920 (setq e1 (match-beginning 0))
1921 (goto-char b1)
1922 (re-search-forward "href\\s *=" e1 t)
1923 (>= p (point))
1924 (progn
1925 (goto-char (match-end 0))
1926 (skip-chars-forward " \t\n")
1927 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
1928 (< p (match-end 0)))))
1929 (setq b1 (match-beginning 1) e1 (match-end 1)
1930 yahtml-completing-buffer (current-buffer)
1931 ;; yahtml-urls-local is buffer-local, so we must put
1932 ;; that into yahtml-urls here
1933 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
1934 href (read-from-minibuffer
1935 "Change href to: " "" yahtml-url-completion-map))
1936 (if (string< "" href)
1937 (progn
1938 ;;(setq href ;??
1939 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))
1940 (delete-region b1 e1)
1941 (goto-char b1)
1942 (insert href))))
1943 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr
1944 (if (and (equal attr "class") ;treat "class" attribute specially
1945 (setq css (yahtml-css-get-element-completion-alist tag)))
1946 (setq new (yahtml-read-parameter ;should be made generic?
1947 attr nil (list (cons "class" css))))
1948 ;;other than "class", read parameter normally
1949 (setq new (yahtml-read-parameter attr)))
1950 (goto-char (car (get 'yahtml-on-assignment-p 'region)))
1951 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))
1952 (insert new))
1953 (t
1954 (save-excursion
1955 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))
1956 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))
1957 (skip-chars-forward "^A-Za-z")
1958 (set-marker q (point))
1959 (setq p (point))
1960 (yahtml-goto-corresponding-begend)
1961 (or (= (char-after (point)) ?<)
1962 (skip-chars-backward "^<"))
1963 (skip-chars-forward "^A-Za-z")
1964 (if (= (char-after (1- (point))) ?/)
1965 (progn
1966 (set-marker q (point))
1967 (goto-char p)))
1968 (setq tag (let ((completion-ignore-case t))
1969 (YaTeX-cplread-with-learning
1970 (format "Change `%s' to(default %s): "
1971 tag yahtml-last-begend)
1972 'default 'user 'tmp)))
1973 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
1974 (if (string= "" tag) (setq tag yahtml-last-begend))
1975 (setq yahtml-last-begend
1976 (or (cdr (assoc tag yahtml-env-table)) tag)
1977 tag yahtml-last-begend)
1978 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))
1979 (insert (format "%s%s" tag (yahtml-addin tag)))
1980 (goto-char q)
1981 (set-marker q nil)
1982 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
1983 (insert tag))))
1984 t))))
1986 (defun yahtml-change-command ()
1987 (let ((p (point)) (case-fold-search t) cmd par new
1988 (beg (make-marker)) (end (make-marker)))
1989 (skip-chars-backward "^<")
1990 (if (and
1991 (looking-at yahtml-command-regexp)
1992 (progn
1993 (set-marker beg (match-beginning 0))
1994 (set-marker end (match-end 0))
1995 t) ;for further work
1996 (progn
1997 (forward-char -1)
1998 (condition-case nil
1999 (forward-list 1)
2000 (error nil))
2001 (< p (point))))
2002 (progn
2003 (goto-char p)
2004 (if (setq par (yahtml-on-assignment-p))
2005 (progn
2006 (setq new (yahtml-read-parameter par))
2007 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))
2008 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))
2009 (setq new
2010 (YaTeX-cplread-with-learning
2011 "Change form to: "
2012 'yahtml-form-table 'yahtml-user-form-table
2013 'yahtml-tmp-form-table)))
2014 (delete-region beg end)
2015 (goto-char beg)
2016 (set-marker beg nil)
2017 (set-marker end nil)
2018 (insert new)
2019 t)
2020 (goto-char p)
2021 nil)))
2023 (defun yahtml-change-* ()
2024 "Change current position's HTML tag (set)."
2025 (interactive)
2026 (cond
2027 ((yahtml-change-begend))
2028 ((yahtml-change-command))
2029 ))
2031 ;;; ---------- commenting ----------
2033 (defun yahtml-comment-region (&optional uncom)
2034 "Comment out region or environment."
2035 (interactive)
2036 (let ((e (make-marker)) be beg p)
2037 (cond
2038 (;(marker-position (set-marker e (yahtml-on-begend-p)))
2039 (setq be (yahtml-on-begend-p))
2040 (save-excursion
2041 (setq p (point))
2042 (if (string-match "^/" be)
2043 (setq beg (progn (forward-line 1) (point)))
2044 (setq beg (progn (beginning-of-line) (point))))
2045 (goto-char p)
2046 (yahtml-goto-corresponding-begend)
2047 (if (string-match "^/" be)
2048 (beginning-of-line)
2049 (forward-line 1))
2050 (set-marker e (point))
2051 ;(comment-region beg (point) (if uncom (list 4)))
2052 ))
2053 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))
2054 (setq beg (region-beginning))
2055 (set-marker e (region-end))))
2056 (if yahtml-translate-hyphens-when-comment-region
2057 (let ((yahtml-entity-reference-chars-alist-default nil)
2058 (yahtml-entity-reference-chars-alist '((?- . "#45")))
2059 yahtml-entity-reference-chars-regexp
2060 yahtml-entity-reference-chars-reverse-regexp)
2061 (yahtml-entity-reference-chars-setup)
2062 (funcall
2063 (if uncom 'yahtml-translate-reverse-region
2064 'yahtml-translate-region)
2065 beg e)))
2066 (comment-region beg e (if uncom (list 4)))
2067 (set-marker e nil)))
2069 (defun yahtml-uncomment-region ()
2070 (interactive)
2071 (yahtml-comment-region t))
2073 ;;; ---------- translate to entity references ----------
2074 (defvar yahtml-entity-reference-chars-alist-default
2075 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))
2076 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))
2077 "Default translation table from character to entity reference")
2078 (defvar yahtml-entity-reference-chars-alist nil
2079 "*Translation table from character to entity reference")
2080 (defvar yahtml-entity-reference-chars-regexp nil)
2081 (defvar yahtml-entity-reference-chars-reverse-regexp nil)
2083 (defun yahtml-entity-reference-chars-setup ()
2084 (let ((list (append yahtml-entity-reference-chars-alist-default
2085 yahtml-entity-reference-chars-alist)))
2086 (setq yahtml-entity-reference-chars-regexp "["
2087 yahtml-entity-reference-chars-reverse-regexp "&\\(")
2088 (while list
2089 (setq yahtml-entity-reference-chars-regexp
2090 (concat yahtml-entity-reference-chars-regexp
2091 (char-to-string (car (car list))))
2092 yahtml-entity-reference-chars-reverse-regexp
2093 (concat yahtml-entity-reference-chars-reverse-regexp
2094 (cdr (car list))
2095 (if (cdr list) "\\|")))
2096 (setq list (cdr list)))
2097 (setq yahtml-entity-reference-chars-regexp
2098 (concat yahtml-entity-reference-chars-regexp "]")
2099 yahtml-entity-reference-chars-reverse-regexp
2100 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))
2102 (yahtml-entity-reference-chars-setup)
2104 (defun yahtml-translate-region (beg end)
2105 "Translate inhibited literals."
2106 (interactive "r")
2107 (save-excursion
2108 (save-restriction
2109 (narrow-to-region beg end)
2110 (let ((ct (append yahtml-entity-reference-chars-alist
2111 yahtml-entity-reference-chars-alist-default)))
2112 (goto-char beg)
2113 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)
2114 ;(setq c (preceding-char))
2115 (replace-match
2116 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))
2118 (defun yahtml-translate-reverse-region (beg end)
2119 "Translate entity references to literals."
2120 (interactive "r")
2121 (save-excursion
2122 (save-restriction
2123 (narrow-to-region beg end)
2124 (let ((ct (append yahtml-entity-reference-chars-alist
2125 yahtml-entity-reference-chars-alist-default))
2126 ec)
2127 (goto-char beg)
2128 (while (re-search-forward
2129 yahtml-entity-reference-chars-reverse-regexp nil t)
2130 ;(setq c (preceding-char))
2131 (setq ec (YaTeX-match-string 1))
2132 (delete-region (match-end 0) (match-beginning 0))
2133 (insert (car (YaTeX-rassoc ec ct))))))))
2135 (defun yahtml-inner-environment-but (exclude &optional quick)
2136 "Return the inner environment but matches with EXCLUDE tag."
2137 (let (e (case-fold-search t))
2138 (save-excursion
2139 (while (and (setq e (YaTeX-inner-environment quick))
2140 (string-match exclude e))
2141 (goto-char (get 'YaTeX-inner-environment 'point))))
2142 e))
2144 ;;; ---------- filling ----------
2145 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))
2146 (defun yahtml-move-to-column (col &optional force)
2147 (beginning-of-line)
2148 (let ((ccol 0))
2149 (while (and (> col ccol) (not (eolp)))
2150 (if (eq (following-char) ?\<)
2151 (progn
2152 (while (and (not (eq (following-char) ?\>))
2153 (not (eolp)))
2154 (forward-char))
2155 (or (eolp) (forward-char)))
2156 (or (eolp) (forward-char))
2157 (if (eq (preceding-char) ?\t)
2158 (let ((wd (- 8 (% (+ ccol 8) 8))))
2159 (if (and force (< col (+ ccol wd)))
2160 (progn
2161 (backward-char 1)
2162 (insert-char ?\ (- col ccol))
2163 (setq ccol col))
2164 (setq ccol (+ ccol wd))))
2165 (setq ccol (1+ ccol)))
2166 (if (and YaTeX-japan
2167 (or
2168 (and (fboundp 'char-category)
2169 (string-match "[chj]" (char-category (preceding-char))))
2170 (and (fboundp 'char-charset)
2171 (not (eq (char-charset (preceding-char)) 'ascii)))))
2172 (setq ccol (1+ ccol)))))
2173 (if (and force (> col ccol))
2174 (progn
2175 (insert-char ?\ (- col ccol))
2176 col)
2177 ccol)))
2179 (defun yahtml-fill-paragraph (arg)
2180 (interactive "P")
2181 (let*((case-fold-search t) (p (point)) fill-prefix
2182 (e (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t) "html"))
2183 indent
2184 (startp (get 'YaTeX-inner-environment 'point))
2185 (prep (string-match "^pre$" e))
2186 (ps1 (if prep (default-value 'paragraph-start)
2187 paragraph-start))
2188 (ps2 (if prep (concat (default-value 'paragraph-start)
2189 "$\\|^\\s *</?pre>")
2190 paragraph-start)))
2191 (save-excursion
2192 (unwind-protect
2193 (progn
2194 (if prep
2195 (fset 'move-to-column 'yahtml-move-to-column))
2196 (save-excursion
2197 (beginning-of-line)
2198 (indent-to-column (yahtml-this-indent))
2199 (setq fill-prefix
2200 (buffer-substring (point) (point-beginning-of-line)))
2201 (delete-region (point) (point-beginning-of-line)))
2202 (fill-region-as-paragraph
2203 (progn (re-search-backward paragraph-start nil t)
2204 (or (save-excursion
2205 (goto-char (match-beginning 0))
2206 (if (looking-at "<")
2207 (forward-list)
2208 (goto-char (match-end 0))
2209 (skip-chars-forward " \t>"))
2210 (if (looking-at "[ \t]*$")
2211 (progn (forward-line 1) (point))))
2212 (point)))
2213 (progn (goto-char p)
2214 (re-search-forward ps2 nil t)
2215 (match-beginning 0))))
2216 (fset 'move-to-column yahtml-saved-move-to-column)))))
2218 ;(defun yahtml-indent-new-commnet-line ()
2219 ; (unwind-protect
2220 ; (progn
2221 ; (fset 'move-to-column 'yahtml-move-to-column)
2222 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))
2223 ; (fset 'move-to-column yahtml-saved-move-to-column)))
2225 ;;;
2226 ;;; ---------- indentation ----------
2227 ;;;
2228 (defun yahtml-indent-line ()
2229 "Indent a line (faster wrapper)"
2230 (interactive)
2231 (let (indent)
2232 (if (and (save-excursion
2233 (beginning-of-line) (skip-chars-forward "\t ")
2234 (not (looking-at "<")))
2235 (save-excursion
2236 (forward-line -1)
2237 (while (and (not (bobp)) (looking-at "^\\s *$"))
2238 (forward-line -1))
2239 (skip-chars-forward "\t ")
2240 (setq indent (current-column))
2241 (not (looking-at "<"))))
2242 (progn
2243 (save-excursion
2244 (beginning-of-line)
2245 (skip-chars-forward " \t")
2246 (or (= (current-column) indent)
2247 (YaTeX-reindent indent)))
2248 (and (bolp) (skip-chars-forward " \t")))
2249 (yahtml-indent-line-real))))
2251 (defun yahtml-this-indent ()
2252 (let ((envs "[uod]l\\|table\\|[ht][rhd0-6]\\|select\\|blockquote\\|center\\|menu\\|dir\\|font")
2253 (itemizing-envs "^\\([uod]l\\|menu\\|dir\\)$")
2254 (itms "<\\(dt\\|dd\\|li\\|t[rdh]\\|option\\)\\b")
2255 (excludes
2256 "\\(a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\\)\\b")
2257 inenv p col peol (case-fold-search t))
2258 (save-excursion
2259 (beginning-of-line)
2260 (setq inenv (or (yahtml-inner-environment-but excludes t)
2261 "html")
2262 col (get 'YaTeX-inner-environment 'indent)
2263 p (get 'YaTeX-inner-environment 'point)
2264 op nil))
2265 (save-excursion
2266 (cond
2267 ((string-match (concat "^\\(" envs "\\)") inenv)
2268 (save-excursion
2269 (beginning-of-line)
2270 (skip-chars-forward " \t")
2271 (cond ;lookup current line's tag
2272 ((looking-at (concat "</\\(" envs "\\)>"))
2273 col)
2274 ((looking-at itms)
2275 (+ col yahtml-environment-indent))
2276 ((and yahtml-hate-too-deep-indentation
2277 (looking-at (concat "<\\(" envs "\\)")))
2278 (+ col (* 2 yahtml-environment-indent)))
2279 ((and (< p (point))
2280 (string-match itemizing-envs inenv)
2281 (save-excursion
2282 (and
2283 (setq op (point))
2284 (goto-char p)
2285 (re-search-forward itms op t)
2286 (progn
2287 (if yahtml-indent-listing-constant
2288 (setq col (+ (current-column)
2289 (if yahtml-faithful-to-htmllint 1 2)))
2290 (skip-chars-forward "^>")
2291 (skip-chars-forward ">")
2292 (skip-chars-forward " \t")
2293 (setq col (if (looking-at "$")
2294 (+ col yahtml-environment-indent)
2295 (current-column))))))))
2296 col)
2297 (t
2298 (+ col yahtml-environment-indent)))))
2299 (t col)))))
2301 (defun yahtml-indent-line-real ()
2302 "Indent current line."
2303 (interactive)
2304 (YaTeX-reindent (yahtml-this-indent))
2305 (if (bolp) (skip-chars-forward " \t"))
2306 (let (peol col inenv)
2307 (if (and (setq inenv (yahtml-on-begend-p))
2308 (string-match
2309 (concat "^\\<\\(" yahtml-struct-name-regexp "\\)") inenv))
2310 (save-excursion
2311 (setq peol (point-end-of-line))
2312 (or (= (char-after (point)) ?<)
2313 (progn (skip-chars-backward "^<") (forward-char -1)))
2314 (setq col (current-column))
2315 (if (and (yahtml-goto-corresponding-begend t)
2316 (> (point) peol)) ;if on the different line
2317 (YaTeX-reindent col))))))
2319 ;(defun yahtml-fill-item ()
2320 ; "Fill item HTML version"
2321 ; (interactive)
2322 ; (let (inenv p fill-prefix peol (case-fold-search t))
2323 ; (setq inenv (or (YaTeX-inner-environment) "html")
2324 ; p (get 'YaTeX-inner-environment 'point))
2325 ; (cond
2326 ; ((string-match "^[uod]l" inenv)
2327 ; (save-excursion
2328 ; (if (re-search-backward "<\\(d[td]\\|li\\)>[ \t\n]*" p t)
2329 ; (progn
2330 ; (goto-char (match-end 0))
2331 ; (setq col (current-column)))
2332 ; (error "No <li>, <dt>, <dd>")))
2333 ; (save-excursion
2334 ; (end-of-line)
2335 ; (setq peol (point))
2336 ; (newline)
2337 ; (indent-to-column col)
2338 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))
2339 ; (delete-region (point) peol)
2340 ; (fill-region-as-paragraph
2341 ; (progn (re-search-backward paragraph-start nil t) (point))
2342 ; (progn (re-search-forward paragraph-start nil t 2)
2343 ; (match-beginning 0)))))
2344 ; (t nil))))
2346 ;;;
2347 ;;; ---------- Lint and Browsing ----------
2348 ;;;
2349 (defun yahtml-browse-menu ()
2350 "Browsing menu"
2351 (interactive)
2352 (message "J)weblint p)Browse R)eload...")
2353 (let ((c (char-to-string (read-char))))
2354 (cond
2355 ((string-match "j" c)
2356 (yahtml-lint-buffer (current-buffer)))
2357 ((string-match "[bp]" c)
2358 (yahtml-browse-current-file))
2359 ((string-match "r" c)
2360 (yahtml-browse-reload)))))
2362 (if (fboundp 'wrap-function-to-control-ime)
2363 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))
2365 (defvar yahtml-lint-buffer "*weblint*")
2367 (defun yahtml-lint-buffer (buf)
2368 "Call lint on buffer BUF."
2369 (require 'yatexprc)
2370 (interactive "bCall lint on buffer: ")
2371 (setq buf (get-buffer buf))
2372 (YaTeX-save-buffers)
2373 (YaTeX-typeset
2374 (concat yahtml-lint-program " "
2375 (file-name-nondirectory (buffer-file-name buf)))
2376 yahtml-lint-buffer "lint" "lint"))
2378 (defun yahtml-file-to-url (file)
2379 "Convert local unix file name to URL.
2380 If no matches found in yahtml-path-url-alist, return raw file name."
2381 (let ((list yahtml-path-url-alist) p url)
2382 (if (file-directory-p file)
2383 (setq file (expand-file-name yahtml-directory-index file))
2384 (setq file (expand-file-name file)))
2385 (if (string-match "^[A-Za-z]:/" file)
2386 (progn
2387 ;; (aset file 1 ?|) ;これは要らないらしい…
2388 (setq file (concat "///" file))))
2389 (while list
2390 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)
2391 (setq url (cdr (car list))
2392 file (substring file (match-end 0))
2393 url (concat url file)
2394 list nil))
2395 (setq list (cdr list)))
2396 (or url (concat "file:" file))))
2398 (defun yahtml-url-to-path (file &optional basedir)
2399 "Convert local URL name to unix file name."
2400 (let ((list yahtml-path-url-alist) url realpath docroot
2401 (dirsufp (string-match "/$" file)))
2402 (setq basedir (or basedir
2403 (file-name-directory
2404 (expand-file-name default-directory))))
2405 (cond
2406 ((string-match "^/" file)
2407 (while list
2408 (if (file-directory-p (car (car list)))
2409 (progn
2410 (setq url (cdr (car list)))
2411 (if (string-match "\\(http://[^/]*\\)/" url)
2412 (setq docroot (substring url (match-end 1)))
2413 (setq docroot url))
2414 (cond
2415 ((string-match (concat "^" (regexp-quote docroot)) file)
2416 (setq realpath
2417 (expand-file-name
2418 (substring
2419 file
2420 (if (= (aref file (1- (match-end 0))) ?/)
2421 (match-end 0) ; "/foo"
2422 (min (1+ (match-end 0)) (length file)))) ; "/~foo"
2423 (car (car list))))))
2424 (if realpath
2425 (progn (setq list nil)
2426 (if (and dirsufp (not (string-match "/$" realpath)))
2427 (setq realpath (concat realpath "/")))))))
2428 (setq list (cdr list)))
2429 realpath)
2430 (t file))))
2432 (defun yahtml-browse-current-file ()
2433 "Call WWW browser on current file."
2434 (interactive)
2435 (basic-save-buffer)
2436 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))
2438 (defun yahtml-browse-reload ()
2439 "Send `reload' event to netzscape."
2440 (let ((pb "* WWW Browser *") (cb (current-buffer)))
2441 (cond
2442 ((string-match "[Nn]etscape" yahtml-www-browser)
2443 (if (get-buffer pb)
2444 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
2445 ;;(or (get 'yahtml-netscape-sentinel 'url)
2446 ;; (error "Reload should be called after Browsing."))
2447 (put 'yahtml-netscape-sentinel 'url
2448 (yahtml-file-to-url (buffer-file-name)))
2449 (basic-save-buffer)
2450 (set-process-sentinel
2451 (setq yahtml-browser-process
2452 (start-process
2453 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
2454 (format "%s -remote 'reload'" yahtml-www-browser)))
2455 'yahtml-netscape-sentinel))
2456 (t
2457 (message "Sorry, RELOAD is supported only for Netscape.")))))
2459 ;;; ---------- Intelligent newline ----------
2460 (defun yahtml-intelligent-newline (arg)
2461 "Intelligent newline for HTML"
2462 (interactive "P")
2463 (let (env func)
2464 (end-of-line)
2465 (setq env (downcase (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t)
2466 "html")))
2467 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))
2468 (newline)
2469 (if (and env func (fboundp func))
2470 ;; if intelligent line function is defined, call that
2471 (funcall func)
2472 ;; else do the default action
2473 (if (string-match yahtml-p-prefered-env-regexp env)
2474 (yahtml-insert-p)))))
2476 (defun yahtml-intelligent-newline-ul ()
2477 (interactive)
2478 (yahtml-insert-single "li")
2479 (or yahtml-faithful-to-htmllint (insert " "))
2480 (yahtml-indent-line))
2482 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)
2484 (defun yahtml-intelligent-newline-dl ()
2485 (interactive)
2486 (let ((case-fold-search t))
2487 (if (save-excursion
2488 (re-search-backward "<\\(\\(dt\\)\\|\\(dd\\)\\)[ \t>]"
2489 (get 'YaTeX-inner-environment 'point) t))
2490 (cond
2491 ((match-beginning 2)
2492 (yahtml-insert-single "dd")
2493 (or yahtml-faithful-to-htmllint (insert " "))
2494 (setq yahtml-last-single-cmd "dt"))
2495 ((match-beginning 3)
2496 (yahtml-insert-single "dt")
2497 (or yahtml-faithful-to-htmllint (insert " "))
2498 (setq yahtml-last-single-cmd "dd")))
2499 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))
2500 (setq yahtml-last-single-cmd "dd"))
2501 (yahtml-indent-line)
2502 (and (string-match yahtml-p-prefered-env-regexp "dl")
2503 (string-equal yahtml-last-single-cmd "dt")
2504 (yahtml-insert-p nil))))
2506 (defun yahtml-intelligent-newline-select ()
2507 (interactive)
2508 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")
2509 (yahtml-indent-line))
2511 (defun yahtml-intelligent-newline-style ()
2512 (interactive)
2513 (if (save-excursion
2514 (and
2515 (re-search-backward "<style\\|<!-- " nil t)
2516 (looking-at "<style")))
2517 (let (c)
2518 (yahtml-indent-line)
2519 (setq c (current-column))
2520 (insert "<!--\n")
2521 (YaTeX-reindent c)
2522 (insert "-->")
2523 (beginning-of-line)
2524 (open-line 1)
2525 (YaTeX-reindent c))))
2527 ;;; ---------- Marking ----------
2528 (defun yahtml-mark-begend ()
2529 "Mark current tag"
2530 (interactive)
2531 (YaTeX-beginning-of-environment)
2532 (let ((p (point)))
2533 (save-excursion
2534 (skip-chars-backward " \t" (point-beginning-of-line))
2535 (if (bolp) (setq p (point))))
2536 (push-mark p t))
2537 (yahtml-goto-corresponding-begend)
2538 (forward-list 1)
2539 (if (eolp) (forward-char 1)))
2541 ;;; ---------- complete marks ----------
2542 (defun yahtml-complete-mark ()
2543 "Complete >, <, &ersand, and "e."
2544 (interactive)
2545 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")
2546 (let ((c (read-char)))
2547 (setq c (if (or (< c ?0) (> c ?7))
2548 (string-match (regexp-quote (char-to-string c)) "<>&\"")
2549 (- c ?1)))
2550 (if (or (< c 0) (> c 6))
2551 nil
2552 (insert (format "&%s;"
2553 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))
2556 ;;; ---------- jump to error line ----------
2557 (defun yahtml-prev-error ()
2558 "Jump to previous error seeing lint buffer."
2559 (interactive)
2560 (or (get-buffer yahtml-lint-buffer)
2561 (error "No lint program ran."))
2562 (YaTeX-showup-buffer yahtml-lint-buffer nil t)
2563 (yahtml-jump-to-error-line t))
2565 (defun yahtml-jump-to-error-line (&optional sit)
2566 (interactive "P")
2567 (let ((p (point)) (e (point-end-of-line)))
2568 (end-of-line)
2569 (if (re-search-backward yahtml-error-line-regexp nil t)
2570 (let ((f (if (string= "" (YaTeX-match-string 1))
2571 YaTeX-current-file-name
2572 (YaTeX-match-string 1)))
2573 (l (string-to-int (or (YaTeX-match-string 2)
2574 (YaTeX-match-string 3)))))
2575 (if sit (sit-for 1))
2576 (forward-line -1)
2577 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)
2578 (goto-line l))
2579 (message "No line number usage"))))
2581 ;;; ---------- Style Sheet Support ----------
2582 (defvar yahtml-css-class-alist nil
2583 "Alist of elements vs. their classes")
2585 (defun yahtml-css-collect-classes-region (beg end &optional initial)
2586 (save-excursion
2587 (save-restriction
2588 (narrow-to-region beg end)
2589 (goto-char (point-min))
2590 (let ((alist initial) b e element class a)
2591 (setq b (point))
2592 (while (search-forward "{" nil t)
2593 (setq e (point))
2594 (goto-char b)
2595 (while (re-search-forward ;ちょといい加減なREGEXP
2596 "\\([a-z][-a-z0-9]*\\)?\\.\\([-a-z0-9][-a-z0-9]*\\)\\>" e t)
2597 (setq element (YaTeX-match-string 1)
2598 class (YaTeX-match-string 2))
2599 ;;if starts with period (match-string 1 is nil),
2600 ;;this is global class
2601 (setq element (downcase (or element "global")))
2602 (if (setq a (assoc element alist))
2603 (or (assoc class (cdr a))
2604 (setcdr a (cons (list class) (cdr a))))
2605 (setq alist (cons (list element (list class)) alist))))
2606 (goto-char (1- e))
2607 (search-forward "}" nil t)
2608 (setq b (point)))
2609 alist))))
2611 (defun yahtml-css-collect-classes-buffer (&optional initial)
2612 (interactive)
2613 (yahtml-css-collect-classes-region (point-min) (point-max) initial))
2615 (defun yahtml-css-collect-classes-file (file &optional initial)
2616 (let*((hilit-auto-highlight nil)
2617 (openedp (get-file-buffer file))
2618 (cb (current-buffer))
2619 (buf (set-buffer (find-file-noselect file))))
2620 (prog1
2621 (yahtml-css-collect-classes-buffer initial)
2622 (or openedp (kill-buffer buf))
2623 (set-buffer cb))))
2625 (defun yahtml-css-scan-styles ()
2626 (save-excursion
2627 (goto-char (point-min))
2628 (set (make-local-variable 'yahtml-css-class-alist) nil)
2629 (let (b tag type e href alist)
2630 (while (re-search-forward "<\\(style\\|link\\)" nil t)
2631 (setq b (match-beginning 0)
2632 tag (YaTeX-match-string 1))
2633 (cond
2634 ((string-match "style" tag)
2635 (goto-char b)
2636 (save-excursion (forward-list 1) (setq e (point)))
2637 (cond
2638 ((search-forward "text/css" e 1) ;css definition starts
2639 (setq alist
2640 (yahtml-css-collect-classes-region
2641 (point) (progn (search-forward "</style>") (point))
2642 alist)))))
2643 ((and (string-match "link" tag)
2644 (stringp (setq type (yahtml-get-attrvalue "type")))
2645 (string-match "text/css" type)
2646 (setq href (yahtml-get-attrvalue "href"))
2647 (file-exists-p (yahtml-url-to-path href)))
2648 (setq alist
2649 (yahtml-css-collect-classes-file
2650 (yahtml-url-to-path href) alist))))
2651 (setq yahtml-css-class-alist alist)))))
2653 (defun yahtml-css-get-element-completion-alist (element)
2654 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))
2655 (global (cdr-safe (assoc "global" yahtml-css-class-alist))))
2656 (and (or alist global)
2657 (append alist global))))
2659 ;;; ---------- ----------
2661 ;;;
2662 ;;hilit19
2663 ;;;
2664 (defvar yahtml-default-face-table
2665 '(
2666 (form black/ivory white/hex-442233 italic)
2667 ))
2668 (defvar yahtml-hilit-patterns-alist
2669 '(
2670 'case-fold
2671 ;; comments
2672 ("<!--\\s " "-->" comment)
2673 ;; include&exec
2674 ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\)" "-->" include)
2675 ;; string
2676 (hilit-string-find ?\\ string)
2677 (yahtml-hilit-region-tag "<\\(em\\|strong\\|b\\)\\>" bold)
2678 ("</?[uod]l>" 0 decl)
2679 ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
2680 (yahtml-hilit-region-tag "<\\(i\\>\\)" italic)
2681 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..
2682 (yahtml-hilit-region-tag "<\\(a\\)\\s +href" crossref)
2683 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
2684 ))
2686 (defun yahtml-hilit-region-tag (tag)
2687 "Return list of start/end point of <TAG> form."
2688 (if (re-search-forward tag nil t)
2689 (let ((m0 (match-beginning 0)) (e0 (match-end 0))
2690 (elm (YaTeX-match-string 1)))
2691 (skip-chars-forward "^>")
2692 (prog1
2693 (cons (1+ (point))
2694 (progn (re-search-forward (concat "</" elm ">") nil t)
2695 (match-beginning 0)))
2696 (goto-char e0)))))
2698 (defun yahtml-hilit-region-tag-itself (ptn)
2699 "Return list of start/end point of <tag options...> itself."
2700 (if (re-search-forward ptn nil t)
2701 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))
2702 (skip-chars-forward "^<>")
2703 (if (eq (char-after (point)) ?<) nil
2704 (prog1
2705 (cons m0 (min (point-max) (1+ (point))))
2706 (goto-char e0))))))
2708 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))
2709 (and yahtml-use-hilit19
2710 (or (assq 'yahtml-mode hilit-patterns-alist)
2711 (setq hilit-patterns-alist
2712 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
2713 hilit-patterns-alist))))
2714 ;;;
2715 ;; for font-lock
2716 ;;;
2718 ; <<STATIC KEYWORDS BELOW NOT USED>>
2719 ;(defvar yahtml-font-lock-keywords
2720 ; '(
2721 ; ;; comments
2722 ; ("<!--\\s .* -->" . font-lock-comment-face)
2723 ; ;; include&exec
2724 ; ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\).*-->"
2725 ; 0 font-lock-include-face keep)
2726 ; ;; string
2727 ; ;(hilit-string-find ?\\ string)
2728 ; ;(yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
2729 ; ("</?[uod]l>" 0 font-lock-keyword-face)
2730 ; ("<\\(di\\|dt\\|li\\|dd\\)>" 0 font-lock-label-face)
2731 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))
2732 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
2733 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))
2734 ; )
2735 ; "*Defualt font-lock-keywords for yahtml-mode.")
2736 (defvar yahtml-font-lock-keywords
2737 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)
2738 "Default fontifying patterns for yahtml-mode")
2740 (defun yahtml-font-lock-set-default-keywords ()
2741 (put 'yahtml-mode 'font-lock-defaults
2742 '(yahtml-font-lock-keywords nil t)))
2744 (if yahtml-use-font-lock
2745 (progn
2746 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
2747 ;;for those who use both hilit19 and font-lock
2748 (if (eq (car hilit-mode-enable-list) 'not)
2749 (or (member 'yahtml-mode hilit-mode-enable-list)
2750 (nconc hilit-mode-enable-list (list 'yahtml-mode)))
2751 (setq hilit-mode-enable-list
2752 (delq 'yahtml-mode hilit-mode-enable-list))))
2753 (yahtml-font-lock-set-default-keywords)))
2755 (defun yahtml-font-lock-recenter (&optional arg)
2756 (interactive "P")
2757 (font-lock-mode -1) ;is stupid, but sure.
2758 (font-lock-mode 1))
2760 ;; (defun yahtml-fontify-to-tagend (lim)
2761 ;; "*Fontify any tag including < and >.
2762 ;; This is invalid use of font-lock function. Therefore
2763 ;; this fontifying will loose effectiveness soon or later."
2764 ;; (let ((start (match-beginning 0))
2765 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))
2766 ;; (or nil; (font-lock-any-faces-p start end)
2767 ;; (font-lock-fillin-text-property
2768 ;; start end 'face 'font-lock font-lock-keyword-face)))
2769 ;; nil)
2771 (run-hooks 'yahtml-load-hook)
2772 (provide 'yahtml)
2774 ; Local variables:
2775 ; fill-prefix: ";;; "
2776 ; paragraph-start: "^$\\| \\|;;;$"
2777 ; paragraph-separate: "^$\\| \\|;;;$"
2778 ; buffer-file-coding-system: sjis
2779 ; End: