yatex

view yahtml.el @ 83:680d92784c1a

Initial revision
author yuuji
date Sun, 27 Sep 2009 13:04:14 +0000
parents 0734be649cb8
children f14ec50103d0
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; (c) 1994-2006 by HIROSE Yuuji [yuuji@yatex.org]
3 ;;; Last modified Sun Dec 24 15:12:35 2006 on firestorm
4 ;;; $Id$
6 (defconst yahtml-revision-number "1.72"
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 ;;; `&gt;', `&lt;', `&amp;', `&quot;' 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 ;;; &lt; &gt; 等が入力できます。
150 ;;; * [prefix] ; 指定したリジョン中の > < & " をそれぞれ
151 ;;; &gt; &lt; &amp; &quot; に変換します。
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 "display" "*Image viewer program")
177 (defvar yahtml-www-browser "firefox" "*WWW Browser command")
178 (defvar yahtml-kanji-code 2
179 "*Kanji coding system number of html file; 1=sjis, 2=jis, 3=euc")
180 ;;(defvar yahtml-coding-system
181 ;; (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))
182 ;; "Kanji coding system")
183 (and (featurep 'mule)
184 (integerp yahtml-kanji-code)
185 (setq yahtml-kanji-code
186 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))))
188 (defvar yahtml-fill-column 72 "*fill culumn used for yahtml-mode")
189 (defvar yahtml-fill-prefix nil "*fill prefix for yahtml-mode")
191 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")
192 (defvar yahtml-path-url-alist nil
193 "*Alist of unix path name vs. URL name of WWW server.
194 Ex.
195 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")
196 (\"/home/yuuji/http\" . \"http://www.gentei.org/~yuuji\"))")
197 (defvar yahtml-directory-index "index.html"
198 "*Directory index file name;
199 Consult your site's WWW administrator.")
201 (defvar yahtml-environment-indent 1
202 "*Indentation depth of HTML's listing environment")
204 ;; YaTeX-japan is defined in yatexlib.el
205 (defvar yahtml-lint-program (if YaTeX-japan "jweblint" "weblint")
206 "*Program name to lint HTML file")
207 (defvar yahtml-hate-too-deep-indentation nil
208 "*Non-nil for this variable suppress deep indentation in listing environments.")
210 (defvar yahtml-always-/p t
211 "*Those who always use <p> with </p> set this to t.")
212 (defvar yahtml-always-/li nil
213 "*Those who always use <li> with </li> set this to t.")
214 (defvar yahtml-always-/dt nil
215 "*Those who always use <dt> with </dt> set this to t.")
216 (defvar yahtml-always-/dd nil
217 "*Those who always use <dd> with </dd> set this to t.")
219 (defvar yahtml-p-prefered-env-regexp "^\\(body\\|dl\\|blockquote\\)"
220 "*Regexp of envs where paragraphed sentences are prefered.")
222 (defvar yahtml-template-file "~/public_html/template.html"
223 "*Template HTML file. It'll be inserted to empty file.")
225 (defvar yahtml-prefer-upcases nil
226 "*Non-nil for preferring upcase TAGs")
228 (defvar yahtml-prefer-upcase-attributes nil
229 "*Non-nil for preferring upcase attributes")
231 (defvar yahtml-server-type 'apache "*WWW server program type")
233 (defvar yahtml-apache-access-file ".htaccess"
234 "*Server access file name for apache")
236 (defvar yahtml-use-css t "*Use stylesheet or not")
238 (defvar yahtml-image-inspection-bytes 10000 ;256
239 "*Number of bytes to inspect the image for geometry information")
240 (defvar yahtml:img-default-alt-format "%xx%y(%sbytes)"
241 "*Default format of img entity's ALT attributes.
242 %x: width, %y: height, %s: size in bytes, %c: first comment string,
243 %f: filename")
245 (defvar yahtml-faithful-to-htmllint nil)
246 (defvar yahtml-error-line-regexp
247 "^\\(.*\\)(\\([0-9]+\\)):\\|^line \\([0-9]+\\)"
248 "*Regexp of error position which is produced by lint program.")
250 (defvar yahtml-translate-hyphens-when-comment-region t
251 "*Non-nil for translate hyphens to &#45; when comment-region")
252 (defvar yahtml-escape-chars 'ask
253 "*Escape reserved characters to URL-encoding or not.
254 Nil for never, t for everytime, and 'ask for inquiring
255 at each reserved chars.")
257 (defvar yahtml-use-font-lock (and (featurep 'font-lock)
258 (fboundp 'font-lock-fontify-region))
259 "*Non-nil means to use font-lock to fontify buffer.")
261 (defvar yahtml-use-hilit19 (and (featurep 'hilit19)
262 (not yahtml-use-font-lock))
263 "*Non-nil means to Use hilit19 to highlight buffer")
265 (defvar yahtml-mode-abbrev-table nil
266 "*Abbrev table in use in yahtml-mode buffers.")
267 (define-abbrev-table 'yahtml-mode-abbrev-table ())
269 (defvar yahtml-indentation-boundary "^\\s *<h[1-3]>"
270 "*Boundary regexp for indentation calculation.")
272 (defvar yahtml-html4-strict t
273 "*Non-nil means editing HTML 4.01 Strict.
274 Completing read for obsoleted attributes disabled.")
276 ;;; --- customizable variable ends here ---
277 (defvar yahtml-prefix-map nil)
278 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")
279 (defvar yahtml-lint-buffer-map nil "Keymap used in lint buffer.")
280 (defvar yahtml-shell-command-option
281 (or (and (boundp 'shell-command-option) shell-command-option)
282 (if (eq system-type 'ms-dos) "/c" "-c")))
283 (defvar yahtml-use-highlighting (or yahtml-use-font-lock yahtml-use-hilit19))
285 (defun yahtml-define-begend-key-normal (key env &optional map)
286 "Define short cut yahtml-insert-begend key."
287 (YaTeX-define-key
288 key
289 (list 'lambda '(arg) '(interactive "P")
290 (list 'yahtml-insert-begend 'arg env))
291 map))
293 (defun yahtml-define-begend-region-key (key env &optional map)
294 "Define short cut yahtml-insert-begend-region key."
295 (YaTeX-define-key key (list 'lambda nil '(interactive)
296 (list 'yahtml-insert-begend t env)) map))
298 (defun yahtml-define-begend-key (key env &optional map)
299 "Define short cut key for begin type completion both for
300 normal and region mode. To customize yahtml, user should use this function."
301 (yahtml-define-begend-key-normal key env map)
302 (if YaTeX-inhibit-prefix-letter nil
303 (yahtml-define-begend-region-key
304 (concat (upcase (substring key 0 1)) (substring key 1)) env map)))
306 (if yahtml-mode-map nil
307 (setq yahtml-mode-map (make-sparse-keymap)
308 yahtml-prefix-map (make-sparse-keymap))
309 (define-key yahtml-mode-map yahtml-prefix yahtml-prefix-map)
310 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)
311 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)
312 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))
313 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)
314 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)
315 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)
316 (define-key yahtml-mode-map "\M-\C-j" 'yahtml-intelligent-newline)
317 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)
318 (define-key yahtml-mode-map "&" 'yahtml-insert-amps)
319 (let ((map yahtml-prefix-map))
320 (YaTeX-define-key "^" 'yahtml-visit-main map)
321 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)
322 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)
323 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)
324 (and YaTeX-emacs-19 window-system
325 (progn
326 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
327 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
328 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
329 (YaTeX-define-key "v" 'yahtml-version map)
330 (YaTeX-define-key "s" 'yahtml-insert-form map)
331 (YaTeX-define-key "l" 'yahtml-insert-tag map)
332 (YaTeX-define-key "L" 'yahtml-insert-tag-region map)
333 (YaTeX-define-key "m" 'yahtml-insert-single map)
334 (YaTeX-define-key "n" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<BR>" "<br>"))) map)
335 (YaTeX-define-key "-" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<HR>" "<hr>") "\n")) map)
336 (YaTeX-define-key "p" 'yahtml-insert-p map)
337 (if YaTeX-no-begend-shortcut
338 (progn
339 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)
340 (YaTeX-define-key "b" 'yahtml-insert-begend map))
341 (yahtml-define-begend-key "bh" "html" map)
342 (yahtml-define-begend-key "bH" "head" map)
343 (yahtml-define-begend-key "bt" "title" map)
344 (yahtml-define-begend-key "bT" "table" map)
345 (yahtml-define-begend-key "bb" "body" map)
346 (yahtml-define-begend-key "bc" "center" map)
347 (yahtml-define-begend-key "bd" "dl" map)
348 (yahtml-define-begend-key "bu" "ul" map)
349 (yahtml-define-begend-key "bo" "ol" map)
350 (yahtml-define-begend-key "b1" "h1" map)
351 (yahtml-define-begend-key "b2" "h2" map)
352 (yahtml-define-begend-key "b3" "h3" map)
353 (yahtml-define-begend-key "ba" "a" map)
354 (yahtml-define-begend-key "bf" "form" map)
355 (yahtml-define-begend-key "bs" "select" map)
356 (yahtml-define-begend-key "bv" "div" map)
357 (yahtml-define-begend-key "bS" "span" map)
358 (yahtml-define-begend-key "bp" "pre" map)
359 (YaTeX-define-key "b " 'yahtml-insert-begend map)
360 (YaTeX-define-key "B " 'yahtml-insert-begend-region map)
361 )
362 (YaTeX-define-key "e" 'YaTeX-end-environment map)
363 (YaTeX-define-key ">" 'yahtml-comment-region map)
364 (YaTeX-define-key "<" 'yahtml-uncomment-region map)
365 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)
366 (YaTeX-define-key "k" 'yahtml-kill-* map)
367 (YaTeX-define-key "c" 'yahtml-change-* map)
368 (YaTeX-define-key "t" 'yahtml-browse-menu map)
369 (YaTeX-define-key "a" 'yahtml-complete-mark map)
370 (YaTeX-define-key "'" 'yahtml-prev-error map)
371 (YaTeX-define-key ";" 'yahtml-translate-region map)
372 (YaTeX-define-key ":" 'yahtml-translate-reverse-region map)
373 (YaTeX-define-key "#" 'yahtml-escape-chars-region map)
374 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
375 (YaTeX-define-key "\e" 'yahtml-quit map)
376 )
377 (substitute-all-key-definition
378 'fill-paragraph 'yahtml-fill-paragraph yahtml-mode-map)
379 (substitute-all-key-definition
380 'kill-buffer 'YaTeX-kill-buffer yahtml-mode-map))
382 (if yahtml-lint-buffer-map nil
383 (setq yahtml-lint-buffer-map (make-keymap))
384 (define-key yahtml-lint-buffer-map " " 'yahtml-jump-to-error-line))
387 (defvar yahtml-paragraph-start
388 (concat
389 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|[bhtd][rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\)\\b")
390 "*Regexp of html paragraph separater")
391 (defvar yahtml-paragraph-separate
392 (concat
393 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|[bhtd][ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\|!--\\)\\b")
394 "*Regexp of html paragraph separater")
395 (defvar yahtml-syntax-table nil
396 "*Syntax table for yahtml-mode")
398 (if yahtml-syntax-table nil
399 (setq yahtml-syntax-table
400 (make-syntax-table (standard-syntax-table)))
401 (modify-syntax-entry ?\< "(>" yahtml-syntax-table)
402 (modify-syntax-entry ?\> ")<" yahtml-syntax-table)
403 (modify-syntax-entry ?\n " " yahtml-syntax-table)
404 )
405 (defvar yahtml-command-regexp "[A-Za-z0-9]+"
406 "Regexp of constituent of html commands.")
408 ;;; Completion tables for `form'
409 (defvar yahtml-form-table
410 '(("img") ("input") ("link") ("meta")))
411 (defvar yahtml-user-form-table nil)
412 (defvar yahtml-tmp-form-table nil)
413 (defvar yahtml-last-form "img")
415 (defvar yahtml-env-table
416 '(("html") ("head") ("title") ("body") ("dl") ("ul") ("ol") ("pre")
417 ("a") ("form") ("select") ("center") ("textarea") ("blockquote")
418 ("OrderedList" . "ol")
419 ("UnorderedList" . "ul")
420 ("DefinitionList" . "dl")
421 ("Preformatted" . "pre")
422 ("table") ("thead") ("tbody") ("tfoot") ("tr") ("th") ("td")
423 ("address")
424 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6")
425 ;; ("p") ;This makes indentation screwed up!
426 ("style") ("script") ("noscript") ("div") ("object") ("ins") ("del")
427 ))
429 (if yahtml-html4-strict
430 (setq yahtml-env-table
431 (delete (assoc "center" yahtml-env-table) yahtml-env-table)))
433 ;(defvar yahtml-itemizing-regexp
434 ; "\\(ul\\|ol\\|dl\\)"
435 ; "Regexp of itemizing forms")
437 (defvar yahtml-user-env-table nil)
438 (defvar yahtml-tmp-env-table nil)
440 ;;; Completion tables for typeface designator
441 (and yahtml-always-/p
442 (or (assoc "p" yahtml-env-table)
443 (setq yahtml-env-table (cons '("p") yahtml-env-table))))
444 (and yahtml-always-/li
445 (or (assoc "li" yahtml-env-table)
446 (setq yahtml-env-table (cons '("li") yahtml-env-table))))
447 (and yahtml-always-/dt
448 (or (assoc "dt" yahtml-env-table)
449 (setq yahtml-env-table (cons '("dt") yahtml-env-table))))
450 (and yahtml-always-/dd
451 (or (assoc "dd" yahtml-env-table)
452 (setq yahtml-env-table (cons '("dd") yahtml-env-table))))
454 (defvar yahtml-typeface-table
455 (append
456 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("caption")
457 ("strong") ("var") ("b") ("i") ("tt") ("big") ("small")
458 ("sup") ("sub") ("span") ("abbr"))
459 (if (not yahtml-html4-strict)
460 '(("strike") ("s") ("u") ("font")))
461 yahtml-env-table)
462 "Default completion table of typeface designator")
463 (defvar yahtml-user-typeface-table nil)
464 (defvar yahtml-tmp-typeface-table nil)
465 (defvar yahtml-last-typeface-cmd "a")
467 (defvar yahtml-single-cmd-table
468 '(("hr") ("br") ("option")
469 ("HorizontalRule" . "hr")
470 ("BreakLine" . "br")
471 ("exec" . "!--#exec")
472 ("!--#exec")
473 ("include" . "!--#include")
474 ("!--#include")
475 ;; ("Item" . "li")
476 ;; ("DefineTerm" . "dt")
477 ;; ("Description" . "dd")
478 ;; ("dd") ("dt") ("li")
479 )
480 "Default completion table of HTML single command.")
481 (defvar yahtml-user-single-cmd-table nil)
482 (defvar yahtml-tmp-single-cmd-table nil)
483 (defvar yahtml-last-single-cmd nil)
485 (defvar yahtml-current-completion-type nil
486 "Has current completion type. This may be used in yahtml addin functions.")
488 ;(defvar yahtml-struct-name-regexp
489 ; "\\<\\(h[1-6]\\|[uod]l\\|html\\|body\\|title\\|head\\|table\\|t[rhd]\\|pre\\|a\\|form\\|select\\|center\\|blockquote\\)\\b")
490 (defvar yahtml-struct-name-regexp
491 (concat
492 "\\<\\("
493 ;(mapconcat 'car yahtml-typeface-table "\\|")
494 (mapconcat 'car yahtml-env-table "\\|")
495 "\\)\\b")
496 "Regexp of structure beginning.")
498 (defvar yahtml-closable-regexp
499 (concat
500 "\\<\\("
501 (mapconcat 'car yahtml-typeface-table "\\|")
502 (mapconcat 'car yahtml-env-table "\\|")
503 "\\)\\b")
504 "Regexp of any closable elemnts.")
506 (defvar yahtml-indent-listing-constant t
507 "*Nil means indentation for listing obeys the column of `>'.
508 T for static indentation depth")
510 (or (assoc "p" yahtml-env-table)
511 (setq yahtml-env-table (cons '("p") yahtml-env-table)))
514 (defun yahtml-get-user-httpconf-entry (regexp)
515 (cond
516 ((and (eq yahtml-server-type 'apache) ;;check .htaccess
517 buffer-file-name)
518 (let ((dir default-directory)
519 charset af ext (ldir "")
520 line
521 (case-fold-search t)
522 (uid (car (cdr (cdr (file-attributes "."))))))
523 (if (string-match "^[A-Z]:" dir)
524 (setq dir (substring dir 2))) ;remove drive letter
525 (while (and dir
526 (not (string= dir ldir))
527 (equal uid (car (cdr (cdr (file-attributes dir))))))
528 (setq af (expand-file-name yahtml-apache-access-file dir))
529 (if (file-exists-p af)
530 (save-excursion
531 (set-buffer (find-file-noselect af))
532 (save-excursion
533 (goto-char (point-min))
534 (if (re-search-forward regexp nil t)
535 (setq line (buffer-substring
536 (point-beginning-of-line)
537 (point-end-of-line))
538 dir nil)))
539 (kill-buffer (current-buffer))))
540 (if dir
541 (setq ldir dir
542 dir (substring dir 0 (string-match "/$" dir))
543 dir (file-name-directory dir))))
544 line
545 ))
546 (t nil))
547 )
549 (defun yahtml-dir-default-charset ()
550 (let*((fn (file-name-nondirectory (or buffer-file-name "")))
551 (ext (substring fn (or (string-match "\\.[a-z0-9]+$" fn) 0)))
552 (ptn (format "^\\s *AddType.*charset=\\(.*\\)\\%s$" ext))
553 (case-fold-search t)
554 line
555 charset)
556 (if (setq line (yahtml-get-user-httpconf-entry ptn))
557 (progn
558 (string-match ptn line)
559 (setq charset
560 (substring line (match-beginning 1) (match-end 1)))
561 (cond
562 ((string-match "iso-2022-jp" charset)
563 (setq charset 2))
564 ((string-match "euc-jp" charset)
565 (setq charset 3))
566 ((string-match "shift_jis" charset)
567 (setq charset 1))
568 ((string-match "utf-8" charset)
569 (setq charset 4))
570 (t (setq charset nil)))
571 (setq dir "")))
572 (if (featurep 'mule)
573 (setq charset (cdr (assq charset YaTeX-kanji-code-alist))))
574 charset))
576 (defun yahtml-get-directory-index ()
577 (let ((line (yahtml-get-user-httpconf-entry "^\\s *DirectoryIndex"))
578 x index-list)
579 ;;s/\\s *$//;
580 (if line
581 (progn
582 (if (string-match "DirectoryIndex\\s +\\(.*\\)\\s *$" line)
583 (setq line (substring line (match-beginning 1) (match-end 1))))
584 (while (string< "" line)
585 (if (setq x (string-match "\\(\\s +\\)" line))
586 (setq index-list (cons (substring line 0 x) index-list)
587 line (substring line (match-end 1)))
588 (setq index-list (cons line index-list)
589 line ""))
590 )
591 (or (nreverse index-list)
592 (if (listp yahtml-directory-index)
593 yahtml-directory-index
594 (list yahtml-directory-index)))))))
596 (defvar yahtml-mode-old-mode nil)
597 (defun yahtml-mode ()
598 (interactive)
599 (let ((old-mm major-mode)) ;Emacs21.0.95 resets major-mode
600 (kill-all-local-variables) ;with kill-all-local-variables
601 (if (not (eq 'yahtml-mode old-mm))
602 (set (make-local-variable 'yahtml-mode-old-mode) old-mm)))
603 (let ((coding (or (yahtml-dir-default-charset) yahtml-kanji-code)))
604 (cond
605 ((null coding) nil)
606 ((and YaTeX-emacs-20 (boundp 'buffer-file-coding-system))
607 (setq buffer-file-coding-system
608 (or (and (fboundp 'set-auto-coding) buffer-file-name
609 (save-excursion
610 (goto-char (point-min))
611 (set-auto-coding buffer-file-name (buffer-size))))
612 coding)))
613 ((featurep 'mule)
614 (set-file-coding-system coding))
615 ((boundp 'NEMACS)
616 (make-local-variable 'kanji-fileio-code)
617 (setq kanji-fileio-code coding))))
618 (setq major-mode 'yahtml-mode
619 mode-name "yahtml"
620 YaTeX-current-file-name (file-name-nondirectory
621 (or (buffer-file-name) ""))
622 local-abbrev-table yahtml-mode-abbrev-table)
623 (mapcar
624 (function (lambda (x)
625 (make-local-variable (car x))
626 (set (car x) (if (and (symbolp (cdr x))
627 (boundp (cdr x)))
628 (symbol-value (cdr x))
629 (cdr x)))))
630 '((YaTeX-ec . "")
631 (YaTeX-struct-begin . "<%1%2")
632 (YaTeX-struct-end . "</%1>")
633 (YaTeX-struct-name-regexp . yahtml-closable-regexp)
634 (YaTeX-comment-prefix . "<!--[^#]")
635 (YaTeX-coding-system . yahtml-kanji-code) ;necessary?
636 (YaTeX-typesetting-mode-map . yahtml-lint-buffer-map)
637 (fill-prefix . yahtml-fill-prefix) (fill-column . yahtml-fill-column)
638 (paragraph-start . yahtml-paragraph-start)
639 (paragraph-separate . yahtml-paragraph-separate)
640 (comment-start . "<!-- ") (comment-end . " -->")
641 (comment-start-skip . comment-start)
642 (indent-line-function . yahtml-indent-line)))
644 (if yahtml-use-font-lock
645 (progn
646 (yahtml-font-lock-set-default-keywords)
647 (or (featurep 'xemacs)
648 (progn
649 (set (make-local-variable 'font-lock-defaults)
650 '(yahtml-font-lock-keywords nil t))
651 ;;(font-lock-mode -1)
652 (font-lock-mode 1) ;;Why should I fontify again???
653 ;; in yatex-mode, there's no need to refontify...
654 (font-lock-fontify-buffer)
655 ))
656 ))
657 (set-syntax-table yahtml-syntax-table)
658 (use-local-map yahtml-mode-map)
659 (YaTeX-read-user-completion-table)
660 (yahtml-css-scan-styles)
661 (turn-on-auto-fill) ;Sorry, this is prerequisite
662 (and (= 0 (buffer-size)) (file-exists-p yahtml-template-file)
663 (y-or-n-p (format "Insert %s?" yahtml-template-file))
664 (insert-file-contents (expand-file-name yahtml-template-file)))
665 (run-hooks 'text-mode-hook 'yahtml-mode-hook)
667 ;; This warning should be removed after a while(2000/12/2)
668 (let ((fld (or (and (local-variable-p 'font-lock-defaults (current-buffer))
669 font-lock-defaults)
670 (get 'yahtml-mode 'font-lock-defaults))))
671 (and fld (not (memq 'yahtml-font-lock-keywords fld))
672 (YaTeX-warning-font-lock "yahtml"))))
674 (defun yahtml-version ()
675 "Return string of the version of running yahtml."
676 (interactive)
677 (message
678 (concat "Yet Another HTML-mode "
679 (if YaTeX-japan "「HTML屋」" "`yahtml'")
680 " Revision "
681 yahtml-revision-number)))
683 (defun yahtml-quit ()
684 (interactive)
685 (and yahtml-mode-old-mode
686 (fboundp yahtml-mode-old-mode)
687 (funcall yahtml-mode-old-mode)))
689 (defun yahtml-define-menu (keymap bindlist)
690 (cond
691 ((featurep 'xemacs)
692 (let ((name (keymap-name (symbol-value keymap))))
693 (set keymap nil)
694 (mapcar
695 (function
696 (lambda (bind)
697 (setq bind (cdr bind))
698 (if (eq (car (cdr bind)) 'lambda)
699 (setcar (cdr bind) 'progn))
700 (if (stringp (car (cdr bind)))
701 (set keymap (cons (cdr bind) (symbol-value keymap)))
702 (set keymap (cons (vector (car bind) (cdr bind) t)
703 (symbol-value keymap))))))
704 bindlist)
705 (set keymap (cons name (symbol-value keymap)))))
706 (t
707 (mapcar
708 (function
709 (lambda (bind)
710 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
711 bindlist))))
713 (defvar yahtml-menu-map nil "Menu map of yahtml")
714 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")
715 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")
716 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")
717 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")
719 ;;; Variables for mosaic url history
720 (defvar yahtml-urls nil "Alist of global history")
721 (defvar yahtml-urls-private nil)
722 (defvar yahtml-urls-local nil)
724 (cond
725 ((and YaTeX-emacs-19 (null yahtml-menu-map))
726 (setq yahtml-menu-map (make-sparse-keymap "yahtml"))
727 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))
728 (YaTeX-define-menu
729 'yahtml-menu-map-sectioning
730 (nreverse
731 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))
732 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))
733 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))
734 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))
735 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))
736 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))
737 )))
738 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))
739 (YaTeX-define-menu
740 'yahtml-menu-map-logical
741 (nreverse
742 '((em "Embolden" .
743 (lambda () (interactive) (yahtml-insert-tag nil "EM")))
744 (dfn "Define a word" .
745 (lambda () (interactive) (yahtml-insert-tag nil "DFN")))
746 (cite "Citation" .
747 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))
748 (code "Code" .
749 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))
750 (kbd "Keyboard" .
751 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))
752 (samp "Sample display" .
753 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))
754 (strong "Strong" .
755 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))
756 (VAR "Variable notation" .
757 (lambda () (interactive) (yahtml-insert-tag nil "VAR")))
758 )))
759 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))
760 (YaTeX-define-menu
761 'yahtml-menu-map-typeface
762 (nreverse
763 '((b "Bold" .
764 (lambda () (interactive) (yahtml-insert-tag nil "B")))
765 (i "Italic" .
766 (lambda () (interactive) (yahtml-insert-tag nil "I")))
767 (tt "Typewriter" .
768 (lambda () (interactive) (yahtml-insert-tag nil "TT")))
769 (u "Underlined" .
770 (lambda () (interactive) (yahtml-insert-tag nil "U")))
771 )))
772 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))
773 (YaTeX-define-menu
774 'yahtml-menu-map-listing
775 (nreverse
776 '((ul "Unordered" .
777 (lambda () (interactive) (yahtml-insert-begend nil "UL")))
778 (ol "Ordered" .
779 (lambda () (interactive) (yahtml-insert-begend nil "OL")))
780 (dl "Definition" .
781 (lambda () (interactive) (yahtml-insert-begend nil "DL")))
782 )))
783 (setq yahtml-menu-map-item (make-sparse-keymap "item"))
784 (YaTeX-define-menu
785 'yahtml-menu-map-item
786 (nreverse
787 '((li "Simple item" .
788 (lambda () (interactive) (yahtml-insert-single "li")))
789 (dt "Define term" .
790 (lambda () (interactive) (yahtml-insert-single "dt")))
791 (dd "Description of term" .
792 (lambda () (interactive) (yahtml-insert-single "dd")))
793 )))
794 (define-key yahtml-mode-map [menu-bar yahtml]
795 (cons "yahtml" yahtml-menu-map))
796 (YaTeX-define-menu
797 'yahtml-menu-map
798 (nreverse
799 (list
800 (cons (list 'sect "Sectioning")
801 (cons "sectioning" yahtml-menu-map-sectioning))
802 (cons (list 'list "Listing")
803 (cons "Listing" yahtml-menu-map-listing))
804 (cons (list 'item "Item")
805 (cons "Itemizing" yahtml-menu-map-item));;;
806 (cons (list 'logi "Logical tags")
807 (cons "logical" yahtml-menu-map-logical))
808 (cons (list 'type "Typeface tags")
809 (cons "typeface" yahtml-menu-map-typeface))
810 )))
811 (if (featurep 'xemacs)
812 (add-hook 'yahtml-mode-hook
813 '(lambda ()
814 (or (assoc "yahtml" current-menubar)
815 (progn
816 (set-buffer-menubar (copy-sequence current-menubar))
817 (add-submenu nil yahtml-menu-map))))))
818 ))
820 ;;; ----------- Completion ----------
821 (defvar yahtml-last-begend "html")
822 (defun yahtml-insert-begend (&optional region env)
823 "Insert <cmd> ... </cmd>."
824 (interactive "P")
825 (setq yahtml-current-completion-type 'multiline)
826 (let*((completion-ignore-case t)
827 (cmd
828 (or env
829 (YaTeX-cplread-with-learning
830 (format "Environment(default %s): " yahtml-last-begend)
831 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))
832 (bolp (save-excursion
833 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))
834 (cc (current-column)))
835 (if (string< "" cmd) (setq yahtml-last-begend cmd))
836 (setq yahtml-last-begend
837 (or (cdr (assoc yahtml-last-begend yahtml-env-table))
838 yahtml-last-begend))
839 (setq cmd yahtml-last-begend)
840 (if yahtml-prefer-upcases (setq cmd (upcase cmd)))
841 (if region
842 ;; We want to keep region effective for new tagged environment
843 ;; to enable continuous regioning by another environment
844 (let ((beg (region-beginning))
845 (end (region-end))
846 (addin (yahtml-addin cmd)))
847 (save-excursion
848 (goto-char end)
849 (insert-before-markers (format "</%s>%s" cmd (if bolp "\n" "")))
850 (goto-char beg)
851 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" "")))))
852 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))
853 (save-excursion
854 (insert "\n")
855 (indent-to-column cc)
856 (insert (format "</%s>" cmd)))
857 (if (string-match "^a\\|p$" cmd) ;aとp決め打ちってのが美しくない…
858 (newline)
859 (yahtml-intelligent-newline nil))
860 (yahtml-indent-line))))
862 (defun yahtml-insert-begend-region ()
863 "Call yahtml-insert-begend in the region mode."
864 (interactive)
865 (yahtml-insert-begend t))
868 (defun yahtml-insert-form (&optional form)
869 "Insert <FORM option=\"argument\">."
870 (interactive)
871 (setq yahtml-current-completion-type 'single)
872 (or form
873 (let ((completion-ignore-case t))
874 (setq form
875 (YaTeX-cplread-with-learning
876 (format "Form(default %s): " yahtml-last-form)
877 'yahtml-form-table 'yahtml-user-form-table
878 'yahtml-tmp-form-table))))
879 (let ((p (point)) q)
880 (if (string= form "") (setq form yahtml-last-form))
881 (setq yahtml-last-form form)
882 (if yahtml-prefer-upcases (setq form (upcase form)))
883 (insert (format "<%s%s>" form (yahtml-addin form)))
884 ;;(indent-relative-maybe)
885 (if (cdr (assoc form yahtml-form-table))
886 (save-excursion (insert (format "</%s>" form))))
887 (if (search-backward "\"\"" p t) (forward-char 1))))
889 (defun yahtml-read-css (alist)
890 (let ((completion-ignore-case t) (delim " ")
891 (minibuffer-completion-table alist))
892 (read-from-minibuffer
893 (substitute-command-keys
894 (if YaTeX-japan
895 "クラス(複数指定は\\[quoted-insert] SPCで区切る): "
896 "class(or class list delimited by \\[quoted-insert] SPC): "))
897 nil YaTeX-minibuffer-completion-map nil)))
899 ;;; ---------- Add-in ----------
900 (defun yahtml-addin (form)
901 "Check add-in function's existence and call it if exists."
902 (let ((addin (concat "yahtml:" (downcase form))) s a)
903 (concat
904 (and (setq a (yahtml-css-get-element-completion-alist form))
905 (not (equal last-command-char ?\C-j))
906 (memq yahtml-current-completion-type '(multiline inline))
907 (yahtml-make-optional-argument ;should be made generic?
908 "class" (yahtml-read-css a)))
909 (if (and (intern-soft addin) (fboundp (intern-soft addin))
910 (stringp (setq s (funcall (intern addin))))
911 (string< "" s))
912 (if (eq (aref s 0) ? ) s (concat " " s))
913 ""))))
915 (defvar yahtml-completing-buffer nil)
916 (defun yahtml-collect-labels (&optional file)
917 "Collect current buffers label (<?? name=...>).
918 If optional argument FILE is specified collect labels in FILE."
919 (let (list end)
920 (save-excursion
921 (set-buffer yahtml-completing-buffer)
922 (if file (let (hilit-auto-highlight)
923 (set-buffer (find-file-noselect file))))
924 (save-excursion
925 (goto-char (point-min))
926 (while ;(re-search-forward "<\\w+\\b" nil t)
927 (re-search-forward "\\(name\\|id\\)\\s *=" nil t)
928 ;(setq bound (match-end 0))
929 ;(search-forward ">" nil t)
930 (setq end (match-end 0))
931 (if (and ;(re-search-backward "\\(name\\|id\\)\\s *=" bound t)
932 (yahtml-on-assignment-p)
933 (progn
934 (goto-char end)
935 (skip-chars-forward " \t\n")
936 (looking-at "\"?#?\\([^\">]+\\)\"?\\b")))
937 (setq list (cons
938 (list (concat "#" (YaTeX-match-string 1)))
939 list))))
940 list)))
941 )
943 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")
944 (if yahtml-url-completion-map nil
945 (setq yahtml-url-completion-map
946 (copy-keymap minibuffer-local-completion-map))
947 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)
948 (define-key yahtml-url-completion-map " " 'yahtml-complete-url)
949 )
951 (defun yahtml-complete-url ()
952 "Complete external URL from history or local file name."
953 (interactive)
954 (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels
955 (lim (YaTeX-minibuffer-begin))
956 (min (if (fboundp 'field-beginning) (field-beginning) (point-min))))
957 (setq initial (YaTeX-minibuffer-string))
958 (cond
959 ((string-match "^http:" initial)
960 (setq cmpl (try-completion initial yahtml-urls)
961 listfunc (list 'lambda nil
962 (list 'all-completions initial 'yahtml-urls))
963 beg min))
964 ((setq beg (string-match "#" initial))
965 (or (equal beg 0) ;begin with #
966 (progn
967 (setq path (substring initial 0 beg))
968 (if (string-match "^/" path)
969 (setq path (yahtml-url-to-path path)))))
970 (setq initial (substring initial beg))
971 (setq labels (yahtml-collect-labels path)
972 cmpl (try-completion initial labels)
973 listfunc (list 'lambda ()
974 (list 'all-completions
975 initial (list 'quote labels)))
976 beg (+ min beg)))
977 (t
978 (setq path (if (string-match "^/" initial)
979 (or (yahtml-url-to-path initial) initial)
980 initial))
981 (setq dir (or (file-name-directory path) ".")
982 file (file-name-nondirectory path)
983 initial file
984 cmpl (file-name-completion file dir)
985 listfunc (list 'lambda nil
986 (list 'file-name-all-completions
987 file dir))
988 beg (save-excursion (skip-chars-backward "^/" lim) (point)))))
989 (cond
990 ((stringp cmpl)
991 (if (string= initial cmpl)
992 (with-output-to-temp-buffer "*Completions*"
993 (princ "Possible completinos are:\n")
994 (princ
995 (mapconcat '(lambda (x) x) (funcall listfunc) "\n")))
996 (delete-region (point) beg)
997 (insert cmpl)))
998 ((null cmpl)
999 (ding))
1000 ((eq t cmpl)
1001 (save-excursion
1002 (unwind-protect
1003 (progn
1004 (goto-char p)
1005 (insert " [Sole completion]"))
1006 (delete-region p (point-max))))))))
1009 ; Subject: [yatex:02849] Re: [yahtml] tilda in href tag
1010 ; From: Masayasu Ishikawa <mimasa@sfc.keio.ac.jp>
1011 ; To: yatex@arcadia.jaist.ac.jp
1012 ; Date: Mon, 31 May 1999 21:09:31 +0900
1013 ; RFC 2396 の "2.4.3. Excluded US-ASCII Characters" によると、以下の文字
1014 ; は必ずエスケープしないといけません。
1016 ; control = <US-ASCII coded characters 00-1F and 7F hexadecimal>
1017 ; space = <US-ASCII coded character 20 hexadecimal>
1018 ; delims = "<" | ">" | "#" | "%" | <">
1019 ; unwise = "{" | "}" | "|" | "\" | "^" | "[" | "]" | "`"
1020 (defvar yahtml-unsafe-chars-regexp
1021 "[][\x0- \x7f <>%\"{}|\\^`]" ;#は除去する
1022 "Characters regexp which must be escaped in URI.")
1024 ; また、以下の文字は予約された用法以外に用いる場合にはエスケープしないと
1025 ; いけないことになっています。
1027 ; reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" |
1028 ; "$" | ","
1029 (defvar yahtml-unreserved-chars-regexp
1030 "[;/?:@&=+$,]"
1031 "Characters regexp which should be escaped in URI on certain conditions.
1032 Not used yet.")
1034 (defun yahtml-escape-chars-string (str)
1035 "Translate reserved chars to URL encoded string."
1036 (let ((p 0) (target "")
1037 (ask (eq yahtml-escape-chars 'ask)))
1038 (cond
1039 ((null yahtml-escape-chars) str)
1040 (t
1041 (while (and (string< "" str)
1042 (setq p (string-match yahtml-unsafe-chars-regexp str)))
1043 (if (and ask (y-or-n-p (format "Escape char [%c] of `%s'"
1044 (aref str p) (substring str 0 (1+ p)))))
1045 (setq target (concat target
1046 (substring str 0 p)
1047 (format "%%%x" (aref str p))))
1048 (setq target (concat target (substring str 0 (1+ p)))))
1049 (setq str (substring str (1+ p))))
1050 (concat target str)))))
1052 (defun yahtml-escape-chars-region (beg end)
1053 "Translate reserved chars to encoded string in the region."
1054 (interactive "r")
1055 (save-excursion
1056 (let ((e (set-marker (make-marker) end)) c m yes)
1057 (goto-char beg)
1058 (while (and (< (point) e)
1059 (re-search-forward
1060 (concat yahtml-unsafe-chars-regexp "\\|"
1061 yahtml-unreserved-chars-regexp) e t))
1062 (sit-for 0)
1063 ; (setq m (buffer-modified-p)
1064 ; c (char-after (1- (point))))
1065 ; (save-excursion (backward-char 1) (insert " ==>"))
1066 ; (unwind-protect
1067 ; (setq yes (y-or-n-p (format "Replace: [%c]" c)))
1068 ; (save-excursion
1069 ; (backward-char 1)
1070 ; (delete-backward-char 4))
1071 ; (set-buffer-modified-p m))
1072 (message "Replace: [%c] (y or n):" (setq c (char-after (1- (point)))))
1073 (if (memq (read-char) '(?y ?Y))
1074 (progn
1075 (delete-region (match-beginning 0) (match-end 0))
1076 (insert (format "%%%x" c)))))
1077 (set-marker e nil))))
1078 ;; ab%defgls/.|
1080 (defun yahtml:a ()
1081 "Add-in function for <a>"
1082 (let ((href ""))
1083 (setq yahtml-completing-buffer (current-buffer)
1084 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
1085 href (yahtml-escape-chars-string
1086 (read-from-minibuffer "href: " "" yahtml-url-completion-map)))
1087 (prog1
1088 (concat (yahtml-make-optional-argument
1089 "href" href)
1090 (yahtml-make-optional-argument
1091 "name" (read-string "name: ")))
1092 (if (and (string-match "^http://" href)
1093 (null (assoc href yahtml-urls-private))
1094 (null (assoc href yahtml-urls-local)))
1095 (YaTeX-update-table
1096 (list href)
1097 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))
1098 )))
1100 (defvar yahtml-parameters-completion-alist
1101 '(("align" ("top") ("middle") ("bottom") ("left") ("right") ("center"))
1102 ("clear" ("left") ("right") ("center") ("all") ("none"))
1103 ("lang" ("ja") ("en") ("kr") ("ch") ("fr"))
1104 ("src" . file) ("file" . file)
1105 ("background" . file)
1106 ("class file name" . file) ("data" . file)
1107 ("method" ("POST") ("GET"))
1108 ("rev" . yahtml-link-types-alist)
1109 ("rel" . yahtml-link-types-alist)
1110 ("type" . yahtml-content-types-alist)
1111 ("codetype" . yahtml-content-types-alist)
1112 ("http-equiv" ("Refresh"))))
1114 (defvar yahtml-link-types-alist
1115 '(("alternate") ("stylesheet") ("start") ("next") ("prev")
1116 ("contents") ("index") ("glossary") ("chapter") ("section")
1117 ("subsection") ("appendix") ("help") ("bookmark")))
1119 (defvar yahtml-content-types-alist
1120 '(("text/css") ("text/html") ("text/plain") ("text/richtext")
1121 ("text/sgml") ("text/xml")
1122 ("text/javascript") ("text/tcl") ("text/vbscript")
1123 ("application/octet-stream") ("application/postscript") ("application/pdf")
1124 ("application/java")
1125 ("image/jpeg") ("image/gif") ("image/tiff") ("image/png") ("video/mpeg"))
1126 "Alist of content-types")
1128 (defun yahtml-read-parameter (par &optional default alist)
1129 (let* ((alist
1130 (cdr-safe (assoc (downcase par)
1131 (or alist yahtml-parameters-completion-alist))))
1132 (prompt (concat par ": "))
1133 v)
1134 (cond
1135 ((eq alist 'file)
1136 (let ((insert-default-directory))
1137 (read-file-name prompt "" default nil "")))
1138 ((and alist (symbolp alist))
1139 (completing-read prompt (symbol-value alist) nil nil default))
1140 (alist
1141 (completing-read prompt alist nil nil default))
1142 (t
1143 (read-string prompt default)))))
1145 (defun yahtml-make-optional-argument (opt arg)
1146 "Make optional argument string."
1147 (if (or (null arg) (string= "" arg))
1148 ""
1149 (concat " "
1150 (if yahtml-prefer-upcase-attributes (upcase opt) (downcase opt))
1151 "=\"" arg "\"")))
1153 (defun yahtml:html ()
1154 "Add-in for <html>"
1155 (setq yahtml-last-begend "head" yahtml-last-typeface-cmd "head")
1156 (yahtml-make-optional-argument
1157 "lang" (yahtml-read-parameter "lang" (if YaTeX-japan "ja"))))
1159 (defun yahtml:head ()
1160 "Add-in for <head>"
1161 (setq yahtml-last-begend "title" yahtml-last-typeface-cmd "title")
1162 "")
1164 (defun yahtml:body ()
1165 "Add-in function for <body>"
1166 (cond
1167 (yahtml-html4-strict nil)
1168 (t
1169 (let ((b (read-string "bgcolor="))
1170 (bg (yahtml-read-parameter "background" ""))
1171 (x (read-string "text color="))
1172 (l (read-string "link color="))
1173 (v (read-string "vlink color=")))
1174 (concat
1175 (yahtml-make-optional-argument "bgcolor" b)
1176 (yahtml-make-optional-argument "background" bg)
1177 (yahtml-make-optional-argument "text" x)
1178 (yahtml-make-optional-argument "link" l)
1179 (yahtml-make-optional-argument "vlink" v))))))
1181 (defun yahtml-make-style-parameter (proplist)
1182 "Make CSS property definitions in style attribute."
1183 (mapconcat
1184 '(lambda (x) (if (and (cdr x) (string< "" (cdr x)))
1185 (format "%s: %s;" (car x) (cdr x))))
1186 (delq nil proplist)
1187 " "))
1189 (defun yahtml:img ()
1190 "Add-in function for <img>"
1191 (let ((src (yahtml-read-parameter "src"))
1192 (alg (yahtml-read-parameter "align"))
1193 alt
1194 (brd (read-string "border="))
1195 (l yahtml-prefer-upcase-attributes)
1196 info width height bytes comments)
1197 (and (stringp src) (string< "" src) (file-exists-p src)
1198 (setq info (yahtml-get-image-info src))
1199 (car info)
1200 (setq width (int-to-string (car info))
1201 height (int-to-string (car (cdr info)))
1202 bytes (car (cdr (cdr info)))
1203 comments (nth 4 info)))
1204 (if info
1205 (setq alt
1206 (YaTeX-replace-formats
1207 yahtml:img-default-alt-format
1208 (list (cons "x" width)
1209 (cons "y" height)
1210 (cons "s" (int-to-string bytes))
1211 (cons "f" (file-name-nondirectory src))
1212 (cons "c" (car comments))))))
1214 (setq alt (yahtml-read-parameter "alt" alt))
1215 (setq width (yahtml-read-parameter "width" width)
1216 height (yahtml-read-parameter "height" height))
1217 (concat (if l "SRC" "src") "=\"" src "\""
1218 (yahtml-make-optional-argument "alt" alt)
1219 (yahtml-make-optional-argument "width" width)
1220 (yahtml-make-optional-argument "height" height)
1221 (if yahtml-html4-strict
1222 (yahtml-make-optional-argument
1223 "style"
1224 (if (or brd alg)
1225 (yahtml-make-style-parameter
1226 (list
1227 (if (string< "" alg)
1228 (cons "align" alg))
1229 (if (string< "" brd)
1230 (cons "border"
1231 (format "%dpx" (string-to-int brd))))))))
1232 (concat
1233 (yahtml-make-optional-argument "border" brd)
1234 (yahtml-make-optional-argument "align" alg))))))
1236 (defun yahtml-file-truename (file)
1237 (cond
1238 ((fboundp 'file-truename) (file-truename (expand-file-name file)))
1239 (t (let ((new file))
1240 (while (and (stringp (setq new (nth 0 (file-attributes file))))
1241 (not (equal new file)))
1242 (setq file new))
1243 file))))
1245 (defun yahtml-hex-value (point length &optional little-endian)
1246 "Return the hex value the POINT positions LENGTH byte stream represents.
1247 Optional third argument LITTLE-ENDIAN is self extplanatory."
1248 (setq point (1+ point)) ;translate file offset to Emacs's point value
1249 (let ((mlt 1)
1250 (pos (if little-endian point (+ point length -1)))
1251 (direc (if little-endian 1 -1))
1252 (value 0))
1253 (while (> length 0)
1254 (setq value (+ value (* mlt (char-after pos)))
1255 pos (+ pos direc)
1256 mlt (* mlt 256)
1257 length (1- length)))
1258 value))
1260 (defun yahtml-get-image-info (file)
1261 "Return the information on the image file FILE.
1262 Returns list of '(WIDTH HEIGHT BYTES DEPTH COMMENTLIST)."
1263 (save-excursion
1264 (let*((tmpbuf (get-buffer-create " *imgheader*"))
1265 width height bytes depth comment
1266 (file-coding-system-alist (list (cons "." 'no-conversion))) ;20
1267 (file-coding-system-for-read (and (boundp '*noconv*) *noconv*)) ;19
1268 (coding-system-for-read 'no-conversion)
1269 (seekpoint 1)
1270 c1 c2 c3 c4 beg end
1271 (case-fold-search nil))
1272 (setq bytes (nth 7 (file-attributes (yahtml-file-truename file))))
1273 (set-buffer tmpbuf)
1274 (if (boundp 'mc-flag) (set (make-local-variable 'mc-flag) nil))
1275 (erase-buffer)
1276 (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))
1277 (unwind-protect
1278 (progn
1279 (message "Inspecting image information of %s..." file)
1280 ;; Read 4bytes-more than inspection-bytes in case that
1281 ;; JPEG marker delimiter (4bytes) is on the alignment.
1282 (YaTeX-insert-file-contents
1283 file nil 0 (+ yahtml-image-inspection-bytes 4))
1284 (goto-char (point-min)) ;assertion
1285 (setq c1 (char-after 1) ;cache first 4 bytes
1286 c2 (char-after 2)
1287 c3 (char-after 3)
1288 c4 (char-after 4))
1289 (cond
1290 ((and (eq c1 ?\377) (eq c2 ?\330)) ; 0xff 0xd8
1291 ;;JPEG images need JPEG markers inspection
1292 ;;JPEG markers consist of [ 0xff ID(B) LEN(S) CONTENTS... ]
1293 ;; Warning: here seekpoint is measured by Emacs's point value
1294 ;; while yahtml-hex-vale requires file offset
1295 (setq seekpoint 3) ;where the first JPEG marker exists
1296 (catch 'exit
1297 (while (< seekpoint (- (buffer-size) 4))
1298 (cond
1299 ((not (eq (char-after seekpoint) ?\377))
1300 ;maybe corrupted, exit from loop
1301 (throw 'exit t))
1302 ((memq
1303 (char-after (1+ seekpoint))
1304 '(?\300 ?\301 ?\302 ?\303
1305 ?\305 ?\306 ?\307 ?\311 ?\312 ?\313 ?\315 ?\316 ?\317))
1306 ;;'(192 193 194 195 197 198 199 201 202 203 205 206 207
1307 ;;found!
1308 (setq height (yahtml-hex-value (+ seekpoint 4) 2)
1309 width (yahtml-hex-value (+ seekpoint 6) 2)
1310 depth (yahtml-hex-value (+ seekpoint 3) 1)))
1311 ((eq (char-after (1+ seekpoint)) ?\376) ;0xFE = comment
1312 ;; JPEG comment area
1313 (setq beg (+ seekpoint 2 2)
1314 end (+ seekpoint
1315 (yahtml-hex-value (1+ seekpoint) 2) 2))
1316 (setq comment (cons (buffer-substring beg end) comment)))
1317 (t ;other markers
1318 nil)) ;just skip it
1319 (setq seekpoint (+ seekpoint 2)
1320 seekpoint (+ seekpoint
1321 (yahtml-hex-value (1- seekpoint) 2))))))
1322 ((and (eq c1 ?\211) ;0x89
1323 (eq c2 ?P) (eq c3 ?N) (eq c4 ?G))
1324 ;;PNG Image data X=@0x10(L), Y=@0x14(L), D=@0x18(B)
1325 (setq width (yahtml-hex-value 16 4)
1326 height (yahtml-hex-value 20 4)
1327 depth (yahtml-hex-value 24 1)))
1328 ((looking-at "GIF8")
1329 ;;GIF Image data X=@0x6(leshort), Y=@0x8(leshort)
1330 (setq width (yahtml-hex-value 6 2 t)
1331 height (yahtml-hex-value 8 2 t)))
1332 ((looking-at "BM")
1333 ;;# OS/2, Windoze BMP files
1334 ;;@0x0e = 12 -> OS/2 1.x - X=@0x12(leshort), Y=@0x14(leshort)
1335 ;;@0x0e = 64 -> OS/2 2.x - X=@0x12(leshort), Y=@0x14(leshort)
1336 ;;@0x0e = 40 -> Windows 3.x - X=@0x12(lelong), Y=@0x16(lelong)
1337 (cond
1338 ((eq (yahtml-hex-value 14 2 t) 40)
1339 (setq width (yahtml-hex-value 18 4 t)
1340 height (yahtml-hex-value 22 4 t)))
1341 (t
1342 (setq width (yahtml-hex-value 18 2 t)
1343 height (yahtml-hex-value 20 2 t)))))
1344 ))
1345 (message "")
1346 (kill-buffer tmpbuf))
1347 (list width height bytes depth (nreverse comment)))))
1349 (defun yahtml:form ()
1350 "Add-in function `form' input format"
1351 (concat
1352 " " (if yahtml-prefer-upcase-attributes "METHOD" "method") "="
1353 (completing-read "Method: " '(("POST") ("GET")) nil t)
1354 " " (if yahtml-prefer-upcase-attributes "ACTION" "action") "=\""
1355 (read-string "Action: ") "\""
1356 ))
1358 (defun yahtml:select ()
1359 "Add-in function for `select' input format"
1360 (setq yahtml-last-single-cmd "option")
1361 (concat " " (if yahtml-prefer-upcase-attributes "NAME" "name") "=\""
1362 (read-string "name: ") "\""))
1364 (defun yahtml:ol ()
1365 "Add-in function for <ol>"
1366 (setq yahtml-last-single-cmd "li")
1367 (let ((start (read-string "start="))
1368 (type (completing-read
1369 "type=" '(("1") ("a") ("A") ("i") ("I")) nil t)))
1370 (concat
1371 (yahtml-make-optional-argument "start" start)
1372 (yahtml-make-optional-argument "type" type))))
1373 (defun yahtml:ul ()
1374 (setq yahtml-last-single-cmd "li") "")
1375 (defun yahtml:dl ()
1376 (setq yahtml-last-single-cmd "dt") "")
1377 (defun yahtml:dt ()
1378 (setq yahtml-last-single-cmd "dd") "")
1380 (defun yahtml:p ()
1381 (if yahtml-html4-strict nil
1382 (let ((alg (yahtml-read-parameter "align")))
1383 (yahtml-make-optional-argument "align" alg))))
1385 (defvar yahtml-input-types
1386 '(("text") ("password") ("checkbox") ("radio") ("submit")
1387 ("reset") ("image") ("hidden") ("file")))
1389 (defun yahtml:input ()
1390 "Add-in function for `input' form"
1391 (let ((size "") name type value checked (maxlength "")
1392 (l yahtml-prefer-upcase-attributes))
1393 (setq name (read-string "name: ")
1394 type (completing-read "type (default=text): "
1395 yahtml-input-types nil t)
1396 value (read-string "value: "))
1397 (if (string-match "text\\|password\\|^$" type)
1398 (setq size (read-string "size: ")
1399 maxlength (read-string "maxlength: ")))
1400 (concat
1401 (if l "NAME" "name") "=\"" name "\""
1402 (yahtml-make-optional-argument "type" type)
1403 (yahtml-make-optional-argument "value" value)
1404 (yahtml-make-optional-argument "size" size)
1405 (yahtml-make-optional-argument "maxlength" maxlength)
1406 )))
1408 (defun yahtml:textarea ()
1409 "Add-in function for `textarea'"
1410 (interactive)
1411 (let (name rows cols)
1412 (setq name (read-string "Name: ")
1413 cols (read-string "Columns: ")
1414 rows (read-string "Rows: "))
1415 (concat
1416 (concat (if yahtml-prefer-upcase-attributes "NAME=" "name=")
1417 "\"" name "\"")
1418 (yahtml-make-optional-argument "cols" cols)
1419 (yahtml-make-optional-argument "rows" rows))))
1421 (defun yahtml:table ()
1422 "Add-in function for `table'"
1423 (let ((b (read-string "border="))
1424 (a (yahtml-read-parameter
1425 "align" nil '(("align" ("right")("center"))))))
1426 (if yahtml-html4-strict
1427 (yahtml-make-optional-argument
1428 "style"
1429 (if (or (string< "" b) (string< "" a))
1430 (yahtml-make-style-parameter
1431 (append
1432 (if (string< "" b)
1433 (list
1434 (cons "border" (format "%dpx solid" (string-to-int b)))
1435 (cons "border-collapse" "collapse")))
1436 (if (string< "" a)
1437 (cond
1438 ((string-match "right" a)
1439 (list (cons "margin-left" "auto")
1440 (cons "margin-right" "0")))
1441 ((string-match "center" a)
1442 (list (cons "margin-left" "auto")
1443 (cons "margin-right" "auto")))))))))
1444 (concat
1445 (yahtml-make-optional-argument "border" b)
1446 (yahtml-make-optional-argument "align" a)))))
1448 ;(fset 'yahtml:caption 'yahtml:p)
1449 (defun yahtml:caption ()
1450 "Add-in function for `caption' in table tag"
1451 (let ((par (yahtml-read-parameter "align")))
1452 (if yahtml-html4-strict
1453 (yahtml-make-optional-argument
1454 "style" (if par (yahtml-make-style-parameter
1455 (list (cons "caption-side" par)))))
1456 (yahtml-make-optional-argument "align" par))))
1458 (defun yahtml:font ()
1459 "Add-in function for `font'"
1460 (concat
1461 (yahtml-make-optional-argument "color" (read-string "color="))
1462 (yahtml-make-optional-argument "size" (read-string "size="))))
1464 (defun yahtml:style ()
1465 "Add-in function for `style'"
1466 (yahtml-make-optional-argument
1467 "type" (read-string "type=" "text/css")))
1469 (defun yahtml:script ()
1470 "Add-in function for `script'"
1471 (concat
1472 (yahtml-make-optional-argument
1473 "type" (yahtml-read-parameter "type" "text/javascript"))
1474 (yahtml-make-optional-argument
1475 "src" (yahtml-read-parameter "src" ""))))
1477 (defun yahtml:tr ()
1478 "Add-in function for `tr'"
1479 (setq ;yahtml-last-begend "td" ;; which do you prefer?
1480 yahtml-last-typeface-cmd "td")
1481 "")
1483 (defun yahtml:link ()
1484 "Add-in function for `link' (まだちょっと良く分かってない)"
1485 (let (rel rev type href)
1486 (setq rel (yahtml-read-parameter "rel"))
1487 (cond
1488 ((equal rel "")
1489 (concat (yahtml-make-optional-argument
1490 "rev" (yahtml-read-parameter "rev"))
1491 (yahtml-make-optional-argument
1492 "href" (yahtml-read-parameter "href")
1493 ;;他に良く使うのって何?
1494 )))
1495 ((string-match "stylesheet" rel)
1496 (concat
1497 (yahtml-make-optional-argument "rel" rel)
1498 (yahtml-make-optional-argument
1499 "type" (yahtml-read-parameter "type" "text/css"))
1500 (progn
1501 (setq href
1502 (read-from-minibuffer "href: " "" yahtml-url-completion-map))
1503 (if (string< "" href)
1504 (progn
1505 (if (and (file-exists-p (yahtml-url-to-path href))
1506 (y-or-n-p "Load css symbols now? "))
1507 (setq yahtml-css-class-alist
1508 (yahtml-css-collect-classes-file
1509 (yahtml-url-to-path href) yahtml-css-class-alist)))
1510 (message "")
1511 (yahtml-make-optional-argument "href" href))))))
1512 (t
1513 (concat
1514 (yahtml-make-optional-argument "rel" rel)
1515 (yahtml-make-optional-argument
1516 "type" (yahtml-read-parameter "type" "text/css"))
1517 (yahtml-make-optional-argument
1518 "href" (read-from-minibuffer "href: " "" yahtml-url-completion-map))
1519 )))))
1521 (defvar yahtml:meta-names
1522 '(("name" ("keywords")("author")("copyright")("date")("GENERATOR"))))
1524 (defun yahtml:meta ()
1525 (let ((name (yahtml-make-optional-argument
1526 "name"
1527 (yahtml-read-parameter "name" nil yahtml:meta-names)))
1528 http-equiv content)
1529 (if (string= "" name)
1530 (if (string-match
1531 "Content-type"
1532 (setq http-equiv (yahtml-make-optional-argument
1533 "http-equiv"
1534 (yahtml-read-parameter "http-equiv" nil))))
1535 (error "It's very bad idea to set Content-type in META. %s"
1536 "See docs/qanda")
1537 (concat http-equiv
1538 (yahtml-make-optional-argument
1539 "content" (yahtml-read-parameter "content"))))
1540 (concat
1541 name
1542 (yahtml-make-optional-argument
1543 "content"
1544 (cond
1545 ((string-match "date" name)
1546 (read-string "Date: " (current-time-string)))
1547 ((string-match "author" name)
1548 (read-string "Author: "
1549 (if (and (user-full-name) (string< "" (user-full-name)))
1550 (user-full-name)
1551 (user-login-name))))
1552 ((string-match "GENERATOR" name)
1553 (setq content (read-string "Generator: " "User-agent: "))
1554 (if (string-match "yahtml" content)
1555 (message "Thank you!"))
1556 content)
1557 (t (read-string (concat name ": ")))))))))
1559 (defun yahtml:br ()
1560 (yahtml-make-optional-argument "clear" (yahtml-read-parameter "clear")))
1562 (defun yahtml:object ()
1563 (let ((codetype (yahtml-read-parameter "codetype" "application/java"))
1564 data classid)
1565 (cond
1566 ((string-match "java" codetype)
1567 (let ((completion-ignored-extensions
1568 ;;any extensions except ".class"
1569 '(".java" ".html" ".htm" ".gif" ".jpg" ".jpeg" ".png")))
1570 (setq classid (concat "java:"
1571 (yahtml-read-parameter "class file name"))))
1572 (concat
1573 (yahtml-make-optional-argument "codetype" codetype)
1574 (yahtml-make-optional-argument "classid" classid)
1575 (yahtml-make-optional-argument
1576 "width" (yahtml-read-parameter "width"))
1577 (yahtml-make-optional-argument
1578 "height" (yahtml-read-parameter "height"))
1579 (yahtml-make-optional-argument
1580 "align" (yahtml-read-parameter "align"))
1581 ))
1582 (t
1583 ""
1584 ))))
1586 (defun yahtml:abbr ()
1587 "Add-in function for abbr."
1588 (yahtml-make-optional-argument "title" (yahtml-read-parameter "title")))
1590 ;;; ---------- Simple tag ----------
1591 (defun yahtml-insert-tag (region-mode &optional tag)
1592 "Insert <TAG> </TAG> and put cursor inside of them."
1593 (interactive "P")
1594 (setq yahtml-current-completion-type 'inline)
1595 (or tag
1596 (let ((completion-ignore-case t))
1597 (setq tag
1598 (YaTeX-cplread-with-learning
1599 (format "Tag %s(default %s): "
1600 (if region-mode "region: " "") yahtml-last-typeface-cmd)
1601 'yahtml-typeface-table 'yahtml-user-typeface-table
1602 'yahtml-tmp-typeface-table))))
1603 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))
1604 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))
1605 (setq yahtml-last-typeface-cmd tag
1606 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))
1607 (if region-mode
1608 (if (if (string< "19" emacs-version) (mark t) (mark))
1609 (save-excursion
1610 (if (> (point) (mark)) (exchange-point-and-mark))
1611 (insert (format "<%s%s>" tag (yahtml-addin tag)))
1612 (exchange-point-and-mark)
1613 (insert "</" tag ">"))
1614 (message "No mark set now"))
1615 (insert (format "<%s%s>" tag (yahtml-addin tag)))
1616 (save-excursion (insert (format "</%s>" tag)))))
1618 (defun yahtml-insert-tag-region (&optional tag)
1619 "Call yahtml-insert-tag with region mode."
1620 (interactive)
1621 (yahtml-insert-tag t tag))
1624 (defvar yahtml-need-single-closer nil) ;for test
1625 (defun yahtml-insert-single (cmd)
1626 "Insert <CMD>."
1627 (interactive
1628 (list
1629 (let ((completion-ignore-case t))
1630 (YaTeX-cplread-with-learning
1631 (format "Command%s: "
1632 (if yahtml-last-single-cmd
1633 (concat "(default " yahtml-last-single-cmd ")") ""))
1634 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table
1635 'yahtml-tmp-single-cmd-table))))
1636 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))
1637 (setq yahtml-last-single-cmd
1638 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))
1639 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
1640 yahtml-last-single-cmd))
1641 (insert (format "<%s%s%s>"
1642 cmd
1643 (yahtml-addin cmd)
1644 (if (and yahtml-need-single-closer
1645 (assoc cmd '(("br")("hr"))))
1646 " /" "")))
1647 (if (assoc cmd yahtml-env-table)
1648 (save-excursion (insert (format "</%s>" cmd)))))
1650 (defun yahtml-insert-p (&optional arg)
1651 "Convenient function to insert <p></p>"
1652 (interactive "P")
1653 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")
1654 (yahtml-insert-single "p")))
1656 (defun yahtml-insert-amps (arg)
1657 "Insert char-entity references via ampersand"
1658 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/
1659 (interactive "P")
1660 (let*((mess "") c
1661 (list (append yahtml-entity-reference-chars-alist-default
1662 yahtml-entity-reference-chars-alist))
1663 (l list))
1664 (while l
1665 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))
1666 l (cdr l)))
1667 (message "Char-entity reference: %s SPC=& RET=&; Other=&#..;" mess)
1668 (setq c (read-char))
1669 (cond
1670 ((equal c (car-safe (assoc c list)))
1671 (insert (format "&%s;" (cdr (assoc c list)))))
1672 ((or (equal c ?\n) (equal c ?\r))
1673 (insert "&;")
1674 (forward-char -1))
1675 ((equal c ? )
1676 (insert ?&))
1677 (t (insert (format "&#%d;" c))))))
1679 (defun yahtml:!--\#include ()
1680 (let ((file (yahtml-read-parameter "file" "")))
1681 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))
1683 (defun yahtml:!--\#exec ()
1684 (format "cmd=\"%s\"--" (yahtml-read-parameter "cmd" "" '(("cmd" . file)))))
1686 ;;; ---------- Jump ----------
1687 (defun yahtml-on-href-p ()
1688 "Check if point is on href clause."
1689 (let ((p (point)) e cmd (case-fold-search t))
1690 (save-excursion
1691 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした
1692 (save-excursion
1693 ;;(search-forward "</a>" nil t) ;aでなくても許可にした
1694 (search-forward "[\" \t\n]" nil t)
1695 (setq e (point)))
1696 ;(goto-char (get 'YaTeX-inner-environment 'point))
1697 (re-search-backward "<\\(a\\|link\\)\\>" nil t)
1698 (search-forward "href" e t)
1699 (search-forward "=" e t)
1700 (progn
1701 (skip-chars-forward " \t\n")
1702 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
1703 (< p (match-end 0))
1704 (YaTeX-match-string 1)
1705 ))))
1707 (defun yahtml-netscape-sentinel (proc mes)
1708 (cond
1709 ((null (buffer-name (process-buffer proc)))
1710 (set-process-buffer proc nil))
1711 ((eq (process-status proc) 'exit)
1712 (let ((cb (current-buffer)))
1713 (set-buffer (process-buffer proc))
1714 (goto-char (point-min))
1715 (if (search-forward "not running" nil t)
1716 (progn
1717 (message "Starting netscape...")
1718 (start-process
1719 "browser" (process-buffer proc)
1720 shell-file-name yahtml-shell-command-option
1721 (format "%s \"%s\"" yahtml-www-browser
1722 (get 'yahtml-netscape-sentinel 'url)))
1723 (message "Starting netscape...Done")))
1724 (set-buffer cb)))))
1726 (defvar yahtml-browser-process nil)
1728 (defun yahtml-browse-html (href)
1729 "Call WWW Browser to see HREF."
1730 (let ((pb "* WWW Browser *") (cb (current-buffer)))
1731 (cond
1732 ((string-match "^start\\>" yahtml-www-browser)
1733 (if (get-buffer pb)
1734 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1735 (put 'yahtml-netscape-sentinel 'url href)
1736 (set-process-sentinel
1737 (setq yahtml-browser-process
1738 (start-process
1739 "browser" pb shell-file-name yahtml-shell-command-option
1740 (format "%s \"%s\"" yahtml-www-browser href)))
1741 'yahtml-netscape-sentinel))
1742 ((and (string-match "[Nn]etscape" yahtml-www-browser)
1743 (not (eq system-type 'windows-nt)))
1744 (if (get-buffer pb)
1745 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1746 (put 'yahtml-netscape-sentinel 'url href)
1747 (set-process-sentinel
1748 (setq yahtml-browser-process
1749 (start-process
1750 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
1751 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))
1752 'yahtml-netscape-sentinel))
1753 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))
1754 (w3-fetch href))
1755 ((stringp yahtml-www-browser)
1756 (if (and yahtml-browser-process
1757 (eq (process-status yahtml-browser-process) 'run))
1758 (message "%s is already running" yahtml-www-browser)
1759 (setq yahtml-browser-process
1760 (start-process
1761 "browser" "* WWW Browser *"
1762 shell-file-name yahtml-shell-command-option
1763 (format "%s \"%s\"" yahtml-www-browser href)))))
1764 (t
1765 (message "Sorry, jump across http is not supported.")))))
1767 (defun yahtml-goto-corresponding-href (&optional other)
1768 "Go to corresponding name."
1769 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))
1770 (if href
1771 (cond
1772 ((string-match "^\\(ht\\|f\\)tps?:" href)
1773 (yahtml-browse-html href))
1774 (t (setq file (substring href 0 (string-match "#" href)))
1775 (if (string-match "#" href)
1776 (setq name (substring href (1+ (string-match "#" href)))))
1777 (if (string< "" file)
1778 (progn
1779 (if (string-match "/$" file)
1780 (or (catch 'dirindex
1781 (mapcar
1782 (function
1783 (lambda (f)
1784 (if (file-exists-p (concat file f))
1785 (throw 'dirindex
1786 (setq file (concat file f))))))
1787 (yahtml-get-directory-index))
1788 nil)
1789 (setq file (concat file yahtml-directory-index))))
1790 (if (string-match "^/" file)
1791 (setq file (yahtml-url-to-path file)))
1792 (if other (YaTeX-switch-to-buffer-other-window file)
1793 (YaTeX-switch-to-buffer file))
1794 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))
1795 (if name
1796 (progn (set-mark-command nil) (yahtml-jump-to-name name)))
1797 t)))))
1799 (defun yahtml-jump-to-name (name)
1800 "Jump to html's named tag."
1801 (setq name (format "\\(name\\|id\\)\\s *=\\s *\"?%s\\>\"?" name))
1802 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))
1803 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))
1804 (message "Named tag `%s' not found" (substring href 1))))
1806 (defun yahtml-on-begend-p (&optional p)
1807 "Check if point is on begend clause."
1808 (let ((p (or p (point))) cmd (case-fold-search t))
1809 (save-excursion
1810 (goto-char p)
1811 (if (equal (char-after (point)) ?<) (forward-char 1))
1812 (if (and (re-search-backward "<" nil t)
1813 (looking-at
1814 ;(concat "<\\(/?" yahtml-struct-name-regexp "\\)\\b")
1815 "<\\(/?[A-Z][A-Z0-9]*\\)\\b"
1817 (condition-case nil
1818 (forward-list 1)
1819 (error nil))
1820 (< p (point)))
1821 (YaTeX-match-string 1)))))
1823 (defun yahtml-goto-corresponding-begend (&optional noerr)
1824 "Go to corresponding opening/closing tag.
1825 Optional argument NOERR causes no error for unballanced tag."
1826 (let ((cmd (yahtml-on-begend-p)) m0
1827 (p (point)) (case-fold-search t) func str (nest 0))
1828 (cond
1829 (cmd
1830 (setq m0 (match-beginning 0))
1831 (if (= (aref cmd 0) ?/) ;on </cmd> line
1832 (setq cmd (substring cmd 1)
1833 str (format "\\(<%s\\)\\|\\(</%s\\)" cmd cmd)
1834 func 're-search-backward)
1835 (setq str (format "\\(</%s\\)\\|\\(<%s\\)" cmd cmd)
1836 func 're-search-forward))
1837 (while (and (>= nest 0) (funcall func str nil t))
1838 (if (equal m0 (match-beginning 0))
1839 nil
1840 (setq nest (+ nest (if (match-beginning 1) -1 1)))))
1841 (if (< nest 0)
1842 (goto-char (match-beginning 0))
1843 (funcall
1844 (if noerr 'message 'error)
1845 "Corresponding tag of `%s' not found." cmd)
1846 (goto-char p)
1847 nil))
1848 (t nil))))
1850 (defun yahtml-current-tag ()
1851 "Return the current tag name including #exec and #include."
1852 (save-excursion
1853 (let ((p (point)) b tag)
1854 (or (bobp)
1855 (looking-at "<")
1856 (progn (skip-chars-backward "^<") (forward-char -1)))
1857 (setq b (point))
1858 (skip-chars-forward "<")
1859 (setq tag (YaTeX-buffer-substring
1860 (point) (progn (skip-chars-forward "^ \t\n") (point))))
1861 (goto-char b)
1862 (forward-list 1)
1863 (and (< p (point)) tag))))
1865 (defun yahtml-get-attrvalue (attr)
1866 "Extract current tag's attribute value from buffer."
1867 (let (e (case-fold-search t))
1868 (save-excursion
1869 (or (looking-at "<")
1870 (progn (skip-chars-backward "^<") (backward-char 1)))
1871 (setq e (save-excursion (forward-list 1) (point)))
1872 (if (and
1873 (re-search-forward (concat "\\b" attr "\\b") e t)
1874 (progn (skip-chars-forward " \t\n=")
1875 (looking-at "\"?\\([^\"> \t\n]+\\)\"?")))
1876 (YaTeX-match-string 1)))))
1878 (defun yahtml-goto-corresponding-img ()
1879 "View image on point"
1880 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))
1881 (if (and tag
1882 (string-match "img" tag)
1883 (setq image (yahtml-get-attrvalue "src")))
1884 (progn
1885 (message "Invoking %s %s..." yahtml-image-viewer image)
1886 (start-process
1887 "Viewer" " * Image Viewer *"
1888 shell-file-name yahtml-shell-command-option ;"-c"
1889 (concat yahtml-image-viewer " " image))
1890 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))
1892 (defun yahtml-goto-corresponding-source (&optional other)
1893 "Goto applet's or script's source."
1894 (let ((env (yahtml-current-tag)) s (p (point)))
1895 (cond
1896 ((string-match "applet" env)
1897 (if (setq s (yahtml-get-attrvalue "code"))
1898 (progn
1899 (setq s (YaTeX-match-string 1)
1900 s (concat
1901 (substring s 0 (string-match "\\.[A-Za-z]+$" s))
1902 ".java"))
1903 (if other (YaTeX-switch-to-buffer-other-window s)
1904 (YaTeX-switch-to-buffer s))
1905 s) ;return source file name
1906 (message "No applet source specified")
1907 (sit-for 1)
1908 nil))
1909 ((string-match "script" env)
1910 (if (setq s (yahtml-get-attrvalue "src"))
1911 (progn
1912 (funcall (if other 'YaTeX-switch-to-buffer-other-window
1913 'YaTeX-switch-to-buffer)
1914 (yahtml-url-to-path s))
1915 s)))
1916 ((string-match "!--#include" env)
1917 (cond
1918 ((setq s (yahtml-get-attrvalue "file")) ;<!--#include file="foo"-->
1919 (if other (YaTeX-switch-to-buffer-other-window s)
1920 (YaTeX-switch-to-buffer s))
1921 s)
1922 ((setq s (yahtml-get-attrvalue "virtual"));<!--#include virtual="foo"-->
1923 (setq s (yahtml-url-to-path s))
1924 (if other (YaTeX-switch-to-buffer-other-window s)
1925 (YaTeX-switch-to-buffer s))
1926 s)))
1927 ((and (string-match "!--#exec" env)
1928 (setq s (yahtml-get-attrvalue "cmd")))
1929 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0
1930 (let ((b " *yahtmltmp*")) ;peek a little
1931 (unwind-protect
1932 (progn
1933 (set-buffer (get-buffer-create b))
1934 (YaTeX-insert-file-contents s nil 0 100)
1935 (if (looking-at "#!")
1936 (if other (YaTeX-switch-to-buffer-other-window s)
1937 (YaTeX-switch-to-buffer s))))
1938 (kill-buffer (get-buffer b)))
1939 (get-file-buffer s))))))
1941 (defun yahtml-goto-corresponding-* (&optional other)
1942 "Go to corresponding object."
1943 (interactive "P")
1944 (cond
1945 ((yahtml-goto-corresponding-href other))
1946 ((yahtml-goto-corresponding-img))
1947 ((yahtml-goto-corresponding-source other))
1948 ((yahtml-goto-corresponding-begend))
1949 (t (message "I don't know where to go."))
1950 ))
1952 (defun yahtml-goto-corresponding-*-other-window ()
1953 "Go to corresponding object."
1954 (interactive)
1955 (yahtml-goto-corresponding-* t))
1957 (defun yahtml-visit-main ()
1958 "Go to parent file from where you visit current file."
1959 (interactive)
1960 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))
1962 ;;; ---------- killing ----------
1963 (defun yahtml-kill-begend (&optional whole)
1964 (let ((tag (yahtml-on-begend-p)) p q r bbolp)
1965 (if tag
1966 (save-excursion
1967 (or (looking-at "<")
1968 (progn (skip-chars-backward "^<") (forward-char -1)))
1969 (setq p (point))
1970 (yahtml-goto-corresponding-begend)
1971 (or (looking-at "<")
1972 (progn (skip-chars-backward "^<") (forward-char -1)))
1973 (if (< (point) p) ;if on the opening tag
1974 (progn (setq q p p (point))
1975 (goto-char q))
1976 (setq q (point))) ;now q has end-line's (point)
1977 (if (not whole)
1978 (kill-region
1979 (progn (skip-chars-backward " \t")
1980 (if (setq bbolp (bolp)) (point) q))
1981 (progn (forward-list 1)
1982 (setq r (point))
1983 (skip-chars-forward " \t")
1984 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))
1985 (goto-char p)
1986 (skip-chars-backward " \t")
1987 (if (not whole)
1988 (progn
1989 (kill-append
1990 (buffer-substring
1991 (setq p (if (setq bbolp (bolp)) (point) p))
1992 (setq q (progn
1993 (forward-list 1)
1994 (setq r (point))
1995 (skip-chars-forward " \t")
1996 (if (and bbolp (eolp) (not (eobp)))
1997 (1+ (point))
1998 r))))
1999 t)
2000 (delete-region p q))
2001 (kill-region
2002 (if (bolp) (point) p)
2003 (progn (goto-char q)
2004 (forward-list 1)
2005 (setq r (point))
2006 (skip-chars-forward " \t")
2007 (if (and (eolp) (not (eobp))) (1+ (point)) r))))
2008 tag))))
2010 (defun yahtml-kill-* (whole)
2011 "Kill current position's HTML tag (set)."
2012 (interactive "P")
2013 (cond
2014 ((yahtml-kill-begend whole))
2015 ))
2018 ;;; ---------- changing ----------
2019 (defun yahtml-on-assignment-p ()
2020 "Return if current point is on parameter assignment.
2021 If so, return parameter name, otherwise nil.
2022 This function should be able to treat white spaces in value, but not yet."
2023 (let ((p (point)))
2024 (save-excursion
2025 (put 'yahtml-on-assignment-p 'region nil)
2026 (skip-chars-backward "^ \t\n")
2027 (and (looking-at "\\([A-Za-z0-9]+\\)\\s *=\\s *\"?\\([^ \t\"]+\\)\"?")
2028 (< p (match-end 0))
2029 (>= p (1- (match-beginning 2)))
2030 (put 'yahtml-on-assignment-p 'region
2031 (cons (match-beginning 2) (match-end 2)))
2032 (YaTeX-match-string 1)))))
2034 (defun yahtml-change-begend ()
2035 (let ((tag (yahtml-on-begend-p))
2036 (completion-ignore-case t)
2037 (case-fold-search t)
2038 (p (point)) (q (make-marker))
2039 (default (append yahtml-env-table yahtml-typeface-table))
2040 (user (append yahtml-user-env-table yahtml-user-typeface-table))
2041 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))
2042 href b1 e1 attr new css)
2043 (cond
2044 (tag
2045 (cond
2046 ((and (string-match "^a$" tag)
2047 (save-excursion
2048 (and
2049 (re-search-backward "<a\\b" nil t)
2050 (progn
2051 (goto-char (match-end 0))
2052 (skip-chars-forward " \t\n")
2053 (setq b1 (point))
2054 (search-forward ">" nil t))
2055 (setq e1 (match-beginning 0))
2056 (goto-char b1)
2057 (re-search-forward "href\\s *=" e1 t)
2058 (>= p (point))
2059 (progn
2060 (goto-char (match-end 0))
2061 (skip-chars-forward " \t\n")
2062 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
2063 (< p (match-end 0)))))
2064 (setq b1 (match-beginning 1) e1 (match-end 1)
2065 yahtml-completing-buffer (current-buffer)
2066 ;; yahtml-urls-local is buffer-local, so we must put
2067 ;; that into yahtml-urls here
2068 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
2069 href (read-from-minibuffer
2070 "Change href to: " "" yahtml-url-completion-map))
2071 (if (string< "" href)
2072 (progn
2073 ;;(setq href ;??
2074 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))
2075 (delete-region b1 e1)
2076 (goto-char b1)
2077 (insert href))))
2078 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr
2079 (if (and (equal attr "class") ;treat "class" attribute specially
2080 (setq css (yahtml-css-get-element-completion-alist tag)))
2082 (setq new (yahtml-read-css css))
2083 ;;other than "class", read parameter normally
2084 (setq new (yahtml-read-parameter attr)))
2085 (goto-char (car (get 'yahtml-on-assignment-p 'region)))
2086 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))
2087 (insert new))
2088 (t
2089 (save-excursion
2090 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))
2091 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))
2092 (skip-chars-forward "^A-Za-z")
2093 (set-marker q (point))
2094 (setq p (point))
2095 (yahtml-goto-corresponding-begend)
2096 (or (= (char-after (point)) ?<)
2097 (skip-chars-backward "^<"))
2098 (skip-chars-forward "^A-Za-z")
2099 (if (= (char-after (1- (point))) ?/)
2100 (progn
2101 (set-marker q (point))
2102 (goto-char p)))
2103 (setq tag (let ((completion-ignore-case t))
2104 (YaTeX-cplread-with-learning
2105 (format "Change `%s' to(default %s): "
2106 tag yahtml-last-begend)
2107 'default 'user 'tmp)))
2108 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
2109 (if (string= "" tag) (setq tag yahtml-last-begend))
2110 (setq yahtml-last-begend
2111 (or (cdr (assoc tag yahtml-env-table)) tag)
2112 tag yahtml-last-begend)
2113 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))
2114 (insert (format "%s%s" tag (yahtml-addin tag)))
2115 (goto-char q)
2116 (set-marker q nil)
2117 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
2118 (insert tag))))
2119 t))))
2121 (defun yahtml-change-command ()
2122 (let ((p (point)) (case-fold-search t) cmd par new
2123 (beg (make-marker)) (end (make-marker)))
2124 (skip-chars-backward "^<")
2125 (if (and
2126 (looking-at yahtml-command-regexp)
2127 (progn
2128 (set-marker beg (match-beginning 0))
2129 (set-marker end (match-end 0))
2130 t) ;for further work
2131 (progn
2132 (forward-char -1)
2133 (condition-case nil
2134 (forward-list 1)
2135 (error nil))
2136 (< p (point))))
2137 (progn
2138 (goto-char p)
2139 (if (setq par (yahtml-on-assignment-p))
2140 (progn
2141 (setq new (yahtml-read-parameter par))
2142 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))
2143 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))
2144 (setq new
2145 (YaTeX-cplread-with-learning
2146 "Change form to: "
2147 'yahtml-form-table 'yahtml-user-form-table
2148 'yahtml-tmp-form-table)))
2149 (delete-region beg end)
2150 (goto-char beg)
2151 (set-marker beg nil)
2152 (set-marker end nil)
2153 (insert new)
2154 t)
2155 (goto-char p)
2156 nil)))
2158 (defun yahtml-change-* ()
2159 "Change current position's HTML tag (set)."
2160 (interactive)
2161 (cond
2162 ((yahtml-change-begend))
2163 ((yahtml-change-command))
2164 ))
2166 ;;; ---------- commenting ----------
2168 (defun yahtml-comment-region (&optional uncom)
2169 "Comment out region or environment."
2170 (interactive)
2171 (let ((e (make-marker)) be beg p)
2172 (cond
2173 (;(marker-position (set-marker e (yahtml-on-begend-p)))
2174 (setq be (yahtml-on-begend-p))
2175 (save-excursion
2176 (setq p (point))
2177 (if (string-match "^/" be)
2178 (setq beg (progn (forward-line 1) (point)))
2179 (setq beg (progn (beginning-of-line) (point))))
2180 (goto-char p)
2181 (yahtml-goto-corresponding-begend)
2182 (if (string-match "^/" be)
2183 (beginning-of-line)
2184 (forward-line 1))
2185 (set-marker e (point))
2186 ;(comment-region beg (point) (if uncom (list 4)))
2187 ))
2188 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))
2189 (setq beg (region-beginning))
2190 (set-marker e (region-end))))
2191 (if yahtml-translate-hyphens-when-comment-region
2192 (let ((yahtml-entity-reference-chars-alist-default nil)
2193 (yahtml-entity-reference-chars-alist '((?- . "#45")))
2194 yahtml-entity-reference-chars-regexp
2195 yahtml-entity-reference-chars-reverse-regexp)
2196 (yahtml-entity-reference-chars-setup)
2197 (funcall
2198 (if uncom 'yahtml-translate-reverse-region
2199 'yahtml-translate-region)
2200 beg e)))
2201 (comment-region beg e (if uncom (list 4)))
2202 (set-marker e nil)))
2204 (defun yahtml-uncomment-region ()
2205 (interactive)
2206 (yahtml-comment-region t))
2208 ;;; ---------- translate to entity references ----------
2209 (defvar yahtml-entity-reference-chars-alist-default
2210 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))
2211 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))
2212 "Default translation table from character to entity reference")
2213 (defvar yahtml-entity-reference-chars-alist nil
2214 "*Translation table from character to entity reference")
2215 (defvar yahtml-entity-reference-chars-regexp nil)
2216 (defvar yahtml-entity-reference-chars-reverse-regexp nil)
2218 (defun yahtml-entity-reference-chars-setup ()
2219 (let ((list (append yahtml-entity-reference-chars-alist-default
2220 yahtml-entity-reference-chars-alist)))
2221 (setq yahtml-entity-reference-chars-regexp "["
2222 yahtml-entity-reference-chars-reverse-regexp "&\\(")
2223 (while list
2224 (setq yahtml-entity-reference-chars-regexp
2225 (concat yahtml-entity-reference-chars-regexp
2226 (char-to-string (car (car list))))
2227 yahtml-entity-reference-chars-reverse-regexp
2228 (concat yahtml-entity-reference-chars-reverse-regexp
2229 (cdr (car list))
2230 (if (cdr list) "\\|")))
2231 (setq list (cdr list)))
2232 (setq yahtml-entity-reference-chars-regexp
2233 (concat yahtml-entity-reference-chars-regexp "]")
2234 yahtml-entity-reference-chars-reverse-regexp
2235 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))
2237 (yahtml-entity-reference-chars-setup)
2239 (defun yahtml-translate-region (beg end)
2240 "Translate inhibited literals."
2241 (interactive "r")
2242 (save-excursion
2243 (save-restriction
2244 (narrow-to-region beg end)
2245 (let ((ct (append yahtml-entity-reference-chars-alist
2246 yahtml-entity-reference-chars-alist-default)))
2247 (goto-char beg)
2248 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)
2249 ;(setq c (preceding-char))
2250 (replace-match
2251 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))
2253 (defun yahtml-translate-reverse-region (beg end)
2254 "Translate entity references to literals."
2255 (interactive "r")
2256 (save-excursion
2257 (save-restriction
2258 (narrow-to-region beg end)
2259 (let ((ct (append yahtml-entity-reference-chars-alist
2260 yahtml-entity-reference-chars-alist-default))
2261 ec)
2262 (goto-char beg)
2263 (while (re-search-forward
2264 yahtml-entity-reference-chars-reverse-regexp nil t)
2265 ;(setq c (preceding-char))
2266 (setq ec (YaTeX-match-string 1))
2267 (delete-region (match-end 0) (match-beginning 0))
2268 (insert (car (YaTeX-rassoc ec ct))))))))
2270 (defun yahtml-inner-environment-but (exclude &optional quick)
2271 "Return the inner environment but matches with EXCLUDE tag."
2272 (let (e (case-fold-search t))
2273 (save-excursion
2274 (while (and (setq e (YaTeX-inner-environment quick))
2275 (string-match exclude e))
2276 (goto-char (get 'YaTeX-inner-environment 'point))))
2277 e))
2279 ;;; ---------- filling ----------
2280 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))
2281 (defun yahtml-move-to-column (col &optional force)
2282 (beginning-of-line)
2283 (let ((ccol 0))
2284 (while (and (> col ccol) (not (eolp)))
2285 (if (eq (following-char) ?\<)
2286 (progn
2287 (while (and (not (eq (following-char) ?\>))
2288 (not (eolp)))
2289 (forward-char))
2290 (or (eolp) (forward-char)))
2291 (or (eolp) (forward-char))
2292 (if (eq (preceding-char) ?\t)
2293 (let ((wd (- 8 (% (+ ccol 8) 8))))
2294 (if (and force (< col (+ ccol wd)))
2295 (progn
2296 (backward-char 1)
2297 (insert-char ?\ (- col ccol))
2298 (setq ccol col))
2299 (setq ccol (+ ccol wd))))
2300 (setq ccol (1+ ccol)))
2301 (if (and YaTeX-japan
2302 (or
2303 (and (fboundp 'char-category)
2304 (string-match "[chj]" (char-category (preceding-char))))
2305 (and (fboundp 'char-charset)
2306 (not (eq (char-charset (preceding-char)) 'ascii)))))
2307 (setq ccol (1+ ccol)))))
2308 (if (and force (> col ccol))
2309 (progn
2310 (insert-char ?\ (- col ccol))
2311 col)
2312 ccol)))
2314 (defun yahtml-fill-paragraph (arg)
2315 (interactive "P")
2316 (let*((case-fold-search t) (p (point)) fill-prefix
2317 (e (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t) "html"))
2318 indent
2319 (startp (get 'YaTeX-inner-environment 'point))
2320 (prep (string-match "^pre$" e))
2321 (ps1 (if prep (default-value 'paragraph-start)
2322 paragraph-start))
2323 (ps2 (if prep (concat (default-value 'paragraph-start)
2324 "$\\|^\\s *</?pre>")
2325 paragraph-start)))
2326 (save-excursion
2327 (unwind-protect
2328 (progn
2329 (if prep
2330 (fset 'move-to-column 'yahtml-move-to-column))
2331 (save-excursion
2332 (beginning-of-line)
2333 (indent-to-column (yahtml-this-indent))
2334 (setq fill-prefix
2335 (buffer-substring (point) (point-beginning-of-line)))
2336 (delete-region (point) (point-beginning-of-line)))
2337 (fill-region-as-paragraph
2338 (progn (re-search-backward paragraph-start nil t)
2339 (or (save-excursion
2340 (goto-char (match-beginning 0))
2341 (if (looking-at "<")
2342 (forward-list)
2343 (goto-char (match-end 0))
2344 (skip-chars-forward " \t>"))
2345 (if (looking-at "[ \t]*$")
2346 (progn (forward-line 1) (point))))
2347 (point)))
2348 (progn (goto-char p)
2349 (re-search-forward ps2 nil t)
2350 (match-beginning 0))))
2351 (fset 'move-to-column yahtml-saved-move-to-column)))))
2353 ;(defun yahtml-indent-new-commnet-line ()
2354 ; (unwind-protect
2355 ; (progn
2356 ; (fset 'move-to-column 'yahtml-move-to-column)
2357 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))
2358 ; (fset 'move-to-column yahtml-saved-move-to-column)))
2360 ;;;
2361 ;;; ---------- indentation ----------
2362 ;;;
2363 (defun yahtml-indent-line ()
2364 "Indent a line (faster wrapper)"
2365 (interactive)
2366 (let (indent)
2367 (if (and (save-excursion
2368 (beginning-of-line) (skip-chars-forward "\t ")
2369 (not (looking-at "<")))
2370 (save-excursion
2371 (forward-line -1)
2372 (while (and (not (bobp)) (looking-at "^\\s *$"))
2373 (forward-line -1))
2374 (skip-chars-forward "\t ")
2375 (setq indent (current-column))
2376 (not (looking-at "<"))))
2377 (progn
2378 (save-excursion
2379 (beginning-of-line)
2380 (skip-chars-forward " \t")
2381 (or (= (current-column) indent)
2382 (YaTeX-reindent indent)))
2383 (and (bolp) (skip-chars-forward " \t")))
2384 (yahtml-indent-line-real))))
2386 (defun yahtml-this-indent ()
2387 (let ((envs "[uod]l\\|table\\|[ht][rhd0-6]\\|select\\|blockquote\\|center\\|menu\\|dir\\|font")
2388 (itemizing-envs "^\\([uod]l\\|menu\\|dir\\)$")
2389 (itms "<\\(dt\\|dd\\|li\\|t[rdh]\\|option\\)\\b")
2390 (excludes
2391 "\\(a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\\)\\b")
2392 inenv p col peol (case-fold-search t))
2393 (save-excursion
2394 (beginning-of-line)
2395 (setq inenv (or (yahtml-inner-environment-but excludes t)
2396 "html")
2397 col (get 'YaTeX-inner-environment 'indent)
2398 p (get 'YaTeX-inner-environment 'point)
2399 op nil))
2400 (save-excursion
2401 (cond
2402 ((string-match (concat "^\\(" envs "\\)") inenv)
2403 (save-excursion
2404 (beginning-of-line)
2405 (skip-chars-forward " \t")
2406 (cond ;lookup current line's tag
2407 ((looking-at (concat "</\\(" envs "\\)>"))
2408 col)
2409 ((looking-at itms)
2410 (+ col yahtml-environment-indent))
2411 ((and yahtml-hate-too-deep-indentation
2412 (looking-at (concat "<\\(" envs "\\)")))
2413 (+ col (* 2 yahtml-environment-indent)))
2414 ((and (< p (point))
2415 (string-match itemizing-envs inenv)
2416 (save-excursion
2417 (and
2418 (setq op (point))
2419 (goto-char p)
2420 (re-search-forward itms op t)
2421 (progn
2422 (if yahtml-indent-listing-constant
2423 (setq col (+ (current-column)
2424 (if yahtml-faithful-to-htmllint 1 2)))
2425 (skip-chars-forward "^>")
2426 (skip-chars-forward ">")
2427 (skip-chars-forward " \t")
2428 (setq col (if (looking-at "$")
2429 (+ col yahtml-environment-indent)
2430 (current-column))))))))
2431 col)
2432 (t
2433 (+ col yahtml-environment-indent)))))
2434 (t col)))))
2436 (defun yahtml-indent-line-real ()
2437 "Indent current line."
2438 (interactive)
2439 (YaTeX-reindent (yahtml-this-indent))
2440 (if (bolp) (skip-chars-forward " \t"))
2441 (let (peol col inenv)
2442 (if (and (setq inenv (yahtml-on-begend-p))
2443 (string-match
2444 (concat "^\\<\\(" yahtml-struct-name-regexp "\\)") inenv))
2445 (save-excursion
2446 (setq peol (point-end-of-line))
2447 (or (= (char-after (point)) ?<)
2448 (progn (skip-chars-backward "^<") (forward-char -1)))
2449 (setq col (current-column))
2450 (if (and (yahtml-goto-corresponding-begend t)
2451 (> (point) peol)) ;if on the different line
2452 (YaTeX-reindent col))))))
2454 ;(defun yahtml-fill-item ()
2455 ; "Fill item HTML version"
2456 ; (interactive)
2457 ; (let (inenv p fill-prefix peol (case-fold-search t))
2458 ; (setq inenv (or (YaTeX-inner-environment) "html")
2459 ; p (get 'YaTeX-inner-environment 'point))
2460 ; (cond
2461 ; ((string-match "^[uod]l" inenv)
2462 ; (save-excursion
2463 ; (if (re-search-backward "<\\(d[td]\\|li\\)>[ \t\n]*" p t)
2464 ; (progn
2465 ; (goto-char (match-end 0))
2466 ; (setq col (current-column)))
2467 ; (error "No <li>, <dt>, <dd>")))
2468 ; (save-excursion
2469 ; (end-of-line)
2470 ; (setq peol (point))
2471 ; (newline)
2472 ; (indent-to-column col)
2473 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))
2474 ; (delete-region (point) peol)
2475 ; (fill-region-as-paragraph
2476 ; (progn (re-search-backward paragraph-start nil t) (point))
2477 ; (progn (re-search-forward paragraph-start nil t 2)
2478 ; (match-beginning 0)))))
2479 ; (t nil))))
2481 ;;;
2482 ;;; ---------- Lint and Browsing ----------
2483 ;;;
2484 (defun yahtml-browse-menu ()
2485 "Browsing menu"
2486 (interactive)
2487 (message "J)weblint p)Browse R)eload...")
2488 (let ((c (char-to-string (read-char))))
2489 (cond
2490 ((string-match "j" c)
2491 (yahtml-lint-buffer (current-buffer)))
2492 ((string-match "[bp]" c)
2493 (yahtml-browse-current-file))
2494 ((string-match "r" c)
2495 (yahtml-browse-reload)))))
2497 (if (fboundp 'wrap-function-to-control-ime)
2498 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))
2500 (defvar yahtml-lint-buffer "*weblint*")
2502 (defun yahtml-lint-buffer (buf)
2503 "Call lint on buffer BUF."
2504 (require 'yatexprc)
2505 (interactive "bCall lint on buffer: ")
2506 (setq buf (get-buffer buf))
2507 (YaTeX-save-buffers)
2508 (YaTeX-typeset
2509 (concat yahtml-lint-program " "
2510 (file-name-nondirectory (buffer-file-name buf)))
2511 yahtml-lint-buffer "lint" "lint"))
2513 (defun yahtml-file-to-url (file)
2514 "Convert local unix file name to URL.
2515 If no matches found in yahtml-path-url-alist, return raw file name."
2516 (let ((list yahtml-path-url-alist) p url)
2517 (if (file-directory-p file)
2518 (setq file (expand-file-name yahtml-directory-index file))
2519 (setq file (expand-file-name file)))
2520 (if (string-match "^[A-Za-z]:/" file)
2521 (progn
2522 ;; (aset file 1 ?|) ;これは要らないらしい…
2523 (setq file (concat "///" file))))
2524 (while list
2525 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)
2526 (setq url (cdr (car list))
2527 file (substring file (match-end 0))
2528 url (concat url file)
2529 list nil))
2530 (setq list (cdr list)))
2531 (or url (concat "file:" file))))
2533 (defun yahtml-url-to-path (file &optional basedir)
2534 "Convert local URL name to unix file name."
2535 (let ((list yahtml-path-url-alist) url realpath docroot
2536 (dirsufp (string-match "/$" file)))
2537 (setq basedir (or basedir
2538 (file-name-directory
2539 (expand-file-name default-directory))))
2540 (cond
2541 ((string-match "^/" file)
2542 (while list
2543 (if (file-directory-p (car (car list)))
2544 (progn
2545 (setq url (cdr (car list)))
2546 (if (string-match "\\(http://[^/]*\\)/" url)
2547 (setq docroot (substring url (match-end 1)))
2548 (setq docroot url))
2549 (cond
2550 ((string-match (concat "^" (regexp-quote docroot)) file)
2551 (setq realpath
2552 (expand-file-name
2553 (substring
2554 file
2555 (if (= (aref file (1- (match-end 0))) ?/)
2556 (match-end 0) ; "/foo"
2557 (min (1+ (match-end 0)) (length file)))) ; "/~foo"
2558 (car (car list))))))
2559 (if realpath
2560 (progn (setq list nil)
2561 (if (and dirsufp (not (string-match "/$" realpath)))
2562 (setq realpath (concat realpath "/")))))))
2563 (setq list (cdr list)))
2564 realpath)
2565 (t file))))
2567 (defun yahtml-browse-current-file ()
2568 "Call WWW browser on current file."
2569 (interactive)
2570 (basic-save-buffer)
2571 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))
2573 (defun yahtml-browse-reload ()
2574 "Send `reload' event to netzscape."
2575 (let ((pb "* WWW Browser *") (cb (current-buffer)))
2576 (cond
2577 ((string-match "[Nn]etscape" yahtml-www-browser)
2578 (if (get-buffer pb)
2579 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
2580 ;;(or (get 'yahtml-netscape-sentinel 'url)
2581 ;; (error "Reload should be called after Browsing."))
2582 (put 'yahtml-netscape-sentinel 'url
2583 (yahtml-file-to-url (buffer-file-name)))
2584 (basic-save-buffer)
2585 (set-process-sentinel
2586 (setq yahtml-browser-process
2587 (start-process
2588 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
2589 (format "%s -remote 'reload'" yahtml-www-browser)))
2590 'yahtml-netscape-sentinel))
2591 (t
2592 (message "Sorry, RELOAD is supported only for Netscape.")))))
2594 ;;; ---------- Intelligent newline ----------
2595 (defun yahtml-intelligent-newline (arg)
2596 "Intelligent newline for HTML"
2597 (interactive "P")
2598 (let (env func)
2599 (end-of-line)
2600 (setq env (downcase (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t)
2601 "html")))
2602 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))
2603 (newline)
2604 (if (and env func (fboundp func))
2605 ;; if intelligent line function is defined, call that
2606 (funcall func)
2607 ;; else do the default action
2608 (if (string-match yahtml-p-prefered-env-regexp env)
2609 (yahtml-insert-p)))))
2611 (defun yahtml-intelligent-newline-ul ()
2612 (interactive)
2613 (yahtml-insert-single "li")
2614 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))
2615 (yahtml-indent-line))
2617 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)
2619 (defun yahtml-intelligent-newline-dl ()
2620 (interactive)
2621 (let ((case-fold-search t))
2622 (if (save-excursion
2623 (re-search-backward "<\\(\\(dt\\)\\|\\(dd\\)\\)[ \t>]"
2624 (get 'YaTeX-inner-environment 'point) t))
2625 (cond
2626 ((match-beginning 2)
2627 (yahtml-insert-single "dd")
2628 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))
2629 (setq yahtml-last-single-cmd "dt"))
2630 ((match-beginning 3)
2631 (yahtml-insert-single "dt")
2632 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))
2633 (setq yahtml-last-single-cmd "dd")))
2634 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))
2635 (setq yahtml-last-single-cmd "dd"))
2636 (yahtml-indent-line)
2637 (and (string-match yahtml-p-prefered-env-regexp "dl")
2638 (string-equal yahtml-last-single-cmd "dt")
2639 (yahtml-insert-p nil))))
2641 (defun yahtml-intelligent-newline-select ()
2642 (interactive)
2643 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")
2644 (yahtml-indent-line))
2646 (defun yahtml-intelligent-newline-style ()
2647 (interactive)
2648 (if (save-excursion
2649 (and
2650 (re-search-backward "<style\\|<!-- " nil t)
2651 (looking-at "<style")))
2652 (let (c)
2653 (yahtml-indent-line)
2654 (setq c (current-column))
2655 (insert "<!--\n")
2656 (YaTeX-reindent c)
2657 (insert "-->")
2658 (beginning-of-line)
2659 (open-line 1)
2660 (YaTeX-reindent c))))
2662 (defun yahtml-intelligent-newline-head ()
2663 (let ((title (read-string "Document title: "))
2664 (b "<title>") (e "</title>") p)
2665 (yahtml-indent-line)
2666 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))
2667 (setq p (point))
2668 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))
2669 (if (string= "" title) (goto-char p))
2670 (setq yahtml-last-begend "body")))
2672 (defun yahtml-intelligent-newline-script ()
2673 (let ((p (point)) b)
2674 (if (save-excursion
2675 (and
2676 (setq b (re-search-backward "<script\\>" nil t))
2677 (re-search-forward
2678 "\\(javascript\\)\\|\\(tcl\\)\\|\\(vbscript\\)" p t)))
2679 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))
2680 c (srcp (re-search-backward "src=" b t)))
2681 (goto-char p)
2682 (yahtml-indent-line)
2683 (setq c (current-column))
2684 (if srcp
2685 nil
2686 (insert "<!--\n" (cond (js "//") (tcl "#") (vb "'")) " -->")
2687 (beginning-of-line)
2688 (open-line 1)
2689 (YaTeX-reindent c))))))
2691 ;;; ---------- Marking ----------
2692 (defun yahtml-mark-begend ()
2693 "Mark current tag"
2694 (interactive)
2695 (YaTeX-beginning-of-environment)
2696 (let ((p (point)))
2697 (save-excursion
2698 (skip-chars-backward " \t" (point-beginning-of-line))
2699 (if (bolp) (setq p (point))))
2700 (push-mark p t))
2701 (yahtml-goto-corresponding-begend)
2702 (forward-list 1)
2703 (if (eolp) (forward-char 1)))
2705 ;;; ---------- complete marks ----------
2706 (defun yahtml-complete-mark ()
2707 "Complete &gt, &lt, &ampersand, and &quote."
2708 (interactive)
2709 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")
2710 (let ((c (read-char)))
2711 (setq c (if (or (< c ?0) (> c ?7))
2712 (string-match (regexp-quote (char-to-string c)) "<>&\"")
2713 (- c ?1)))
2714 (if (or (< c 0) (> c 6))
2715 nil
2716 (insert (format "&%s;"
2717 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))
2720 ;;; ---------- jump to error line ----------
2721 (defun yahtml-prev-error ()
2722 "Jump to previous error seeing lint buffer."
2723 (interactive)
2724 (or (get-buffer yahtml-lint-buffer)
2725 (error "No lint program ran."))
2726 (YaTeX-showup-buffer yahtml-lint-buffer nil t)
2727 (yahtml-jump-to-error-line t))
2729 (defun yahtml-jump-to-error-line (&optional sit)
2730 (interactive "P")
2731 (let ((p (point)) (e (point-end-of-line)))
2732 (end-of-line)
2733 (if (re-search-backward yahtml-error-line-regexp nil t)
2734 (let ((f (if (string= "" (YaTeX-match-string 1))
2735 YaTeX-current-file-name
2736 (YaTeX-match-string 1)))
2737 (l (string-to-int (or (YaTeX-match-string 2)
2738 (YaTeX-match-string 3)))))
2739 (if sit (sit-for 1))
2740 (forward-line -1)
2741 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)
2742 (goto-line l))
2743 (message "No line number usage"))))
2745 ;;; ---------- Style Sheet Support ----------
2746 (defvar yahtml-css-class-alist nil
2747 "Alist of elements vs. their classes")
2749 (defun yahtml-css-collect-classes-region (beg end &optional initial)
2750 (save-excursion
2751 (save-restriction
2752 (narrow-to-region beg end)
2753 (goto-char (point-min))
2754 (let ((alist initial) b e element class a)
2755 (setq b (point))
2756 (while (re-search-forward "\\({\\)\\|\\(@import\\)" nil t)
2757 (if (match-beginning 2)
2758 (let ((f (YaTeX-buffer-substring
2759 (progn (skip-chars-forward "^\"")(1+ (point)))
2760 (progn (forward-char 1)
2761 (skip-chars-forward "^\"")(point)))))
2762 (if (file-exists-p f)
2763 (setq alist
2764 (append alist (yahtml-css-collect-classes-file f)))))
2765 (setq e (point))
2766 (goto-char b)
2767 (while (re-search-forward ;ちょといい加減なREGEXP
2768 "\\([a-z][-a-z0-9]*\\)?\\.\\([-a-z0-9][-a-z0-9]*\\)\\>"
2769 e t)
2770 (setq element (YaTeX-match-string 1)
2771 class (YaTeX-match-string 2))
2772 ;;if starts with period (match-string 1 is nil),
2773 ;;this is global class
2774 (setq element (downcase (or element "global")))
2775 (if (setq a (assoc element alist))
2776 (or (assoc class (cdr a))
2777 (setcdr a (cons (list class) (cdr a))))
2778 (setq alist (cons (list element (list class)) alist))))
2779 (goto-char (1- e))
2780 (search-forward "}" nil t)
2781 (setq b (point))))
2782 alist))))
2784 (defun yahtml-css-collect-classes-buffer (&optional initial)
2785 (interactive)
2786 (yahtml-css-collect-classes-region (point-min) (point-max) initial))
2788 (defun yahtml-css-collect-classes-file (file &optional initial)
2789 (let*((hilit-auto-highlight nil)
2790 (openedp (get-file-buffer file))
2791 (cb (current-buffer))
2792 (buf (set-buffer (find-file-noselect file))))
2793 (prog1
2794 (yahtml-css-collect-classes-buffer initial)
2795 (or openedp (kill-buffer buf))
2796 (set-buffer cb))))
2798 (defun yahtml-css-scan-styles ()
2799 (save-excursion
2800 (goto-char (point-min))
2801 (set (make-local-variable 'yahtml-css-class-alist) nil)
2802 (let (b tag type e href alist)
2803 (while (re-search-forward "<\\(style\\|link\\)" nil t)
2804 (setq b (match-beginning 0)
2805 tag (YaTeX-match-string 1))
2806 (cond
2807 ((string-match "style" tag)
2808 (goto-char b)
2809 (save-excursion (forward-list 1) (setq e (point)))
2810 (cond
2811 ((search-forward "text/css" e 1) ;css definition starts
2812 (setq alist
2813 (yahtml-css-collect-classes-region
2814 (point) (progn (search-forward "</style>") (point))
2815 alist)))))
2816 ((and (string-match "link" tag)
2817 (stringp (setq type (yahtml-get-attrvalue "type")))
2818 (string-match "text/css" type)
2819 (setq href (yahtml-get-attrvalue "href"))
2820 (file-exists-p (yahtml-url-to-path href)))
2821 (setq alist
2822 (yahtml-css-collect-classes-file
2823 (yahtml-url-to-path href) alist))))
2824 (setq yahtml-css-class-alist alist)))))
2826 (defun yahtml-css-get-element-completion-alist (element)
2827 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))
2828 (global (cdr-safe (assoc "global" yahtml-css-class-alist))))
2829 (and (or alist global)
2830 (append alist global))))
2832 ;;; ---------- ----------
2834 ;;;
2835 ;;hilit19
2836 ;;;
2837 (defvar yahtml-default-face-table
2838 '(
2839 (form black/ivory white/hex-442233 italic)
2840 ))
2841 (defvar yahtml-hilit-patterns-alist
2842 '(
2843 'case-fold
2844 ;; comments
2845 ("<!--\\s " "-->" comment)
2846 ;; include&exec
2847 ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\)" "-->" include)
2848 ;; string
2849 (hilit-string-find ?\\ string)
2850 (yahtml-hilit-region-tag "<\\(strong\\|b\\)\\>" bold)
2851 ("</?[uod]l>" 0 decl)
2852 ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
2853 (yahtml-hilit-region-tag "<\\(em\\|i\\>\\)" italic)
2854 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..
2855 (yahtml-hilit-region-tag "<\\(a\\)\\s +href" crossref)
2856 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
2857 ))
2859 (defun yahtml-hilit-region-tag (tag)
2860 "Return list of start/end point of <TAG> form."
2861 (if (re-search-forward tag nil t)
2862 (let ((m0 (match-beginning 0)) (e0 (match-end 0))
2863 (elm (YaTeX-match-string 1)))
2864 (skip-chars-forward "^>")
2865 (prog1
2866 (cons (1+ (point))
2867 (progn (re-search-forward (concat "</" elm ">") nil t)
2868 (match-beginning 0)))
2869 (goto-char e0)))))
2871 (defun yahtml-hilit-region-tag-itself (ptn)
2872 "Return list of start/end point of <tag options...> itself."
2873 (if (re-search-forward ptn nil t)
2874 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))
2875 (skip-chars-forward "^<>")
2876 (if (eq (char-after (point)) ?<) nil
2877 (prog1
2878 (cons m0 (min (point-max) (1+ (point))))
2879 (goto-char e0))))))
2881 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))
2882 (and yahtml-use-hilit19
2883 (or (assq 'yahtml-mode hilit-patterns-alist)
2884 (setq hilit-patterns-alist
2885 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
2886 hilit-patterns-alist))))
2887 ;;;
2888 ;; for font-lock
2889 ;;;
2891 ; <<STATIC KEYWORDS BELOW NOT USED>>
2892 ;(defvar yahtml-font-lock-keywords
2893 ; '(
2894 ; ;; comments
2895 ; ("<!--\\s .* -->" . font-lock-comment-face)
2896 ; ;; include&exec
2897 ; ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\).*-->"
2898 ; 0 font-lock-include-face keep)
2899 ; ;; string
2900 ; ;(hilit-string-find ?\\ string)
2901 ; ;(yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
2902 ; ("</?[uod]l>" 0 font-lock-keyword-face)
2903 ; ("<\\(di\\|dt\\|li\\|dd\\)>" 0 font-lock-label-face)
2904 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))
2905 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
2906 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))
2907 ; )
2908 ; "*Defualt font-lock-keywords for yahtml-mode.")
2909 (defvar yahtml-font-lock-keywords
2910 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)
2911 "Default fontifying patterns for yahtml-mode")
2913 (defun yahtml-font-lock-set-default-keywords ()
2914 (put 'yahtml-mode 'font-lock-defaults
2915 '(yahtml-font-lock-keywords nil t)))
2917 (if yahtml-use-font-lock
2918 (progn
2919 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
2920 ;;for those who use both hilit19 and font-lock
2921 (if (eq (car hilit-mode-enable-list) 'not)
2922 (or (member 'yahtml-mode hilit-mode-enable-list)
2923 (nconc hilit-mode-enable-list (list 'yahtml-mode)))
2924 (setq hilit-mode-enable-list
2925 (delq 'yahtml-mode hilit-mode-enable-list))))
2926 (yahtml-font-lock-set-default-keywords)))
2928 (defun yahtml-font-lock-recenter (&optional arg)
2929 (interactive "P")
2930 (font-lock-mode -1) ;is stupid, but sure.
2931 (font-lock-mode 1))
2933 ;; (defun yahtml-fontify-to-tagend (lim)
2934 ;; "*Fontify any tag including < and >.
2935 ;; This is invalid use of font-lock function. Therefore
2936 ;; this fontifying will loose effectiveness soon or later."
2937 ;; (let ((start (match-beginning 0))
2938 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))
2939 ;; (or nil; (font-lock-any-faces-p start end)
2940 ;; (font-lock-fillin-text-property
2941 ;; start end 'face 'font-lock font-lock-keyword-face)))
2942 ;; nil)
2944 (run-hooks 'yahtml-load-hook)
2945 (provide 'yahtml)
2947 ; Local variables:
2948 ; fill-prefix: ";;; "
2949 ; paragraph-start: "^$\\| \\|;;;$"
2950 ; paragraph-separate: "^$\\| \\|;;;$"
2951 ; coding: sjis
2952 ; End: