yatex

view yahtml.el @ 611:e87c3271b8fd

Add "meter" and "progress" completions
author HIROSE Yuuji <yuuji@gentei.org>
date Mon, 17 Jul 2023 17:05:45 +0900
parents 157aa7974191
children
line source
1 ;;; yahtml.el --- Yet Another HTML mode -*- coding: sjis -*-
2 ;;; (c) 1994-2022 by HIROSE Yuuji [yuuji(@)yatex.org]
3 ;;; $Id$
5 (defconst yahtml-revision-number "1.83"
6 "Revision number of running yahtml.el")
8 ;;; Commentary:
10 ;;;[Installation]
11 ;;;
12 ;;; First, you have to install YaTeX and make sure it works fine. Then
13 ;;; put these expressions into your ~/.emacs
14 ;;;
15 ;;; (setq auto-mode-alist
16 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))
17 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)
18 ;;; (setq yahtml-www-browser "firefox")
19 ;;; ;Write your favorite browser. But firefox is advantageous.
20 ;;; (setq yahtml-path-url-alist
21 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")
22 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))
23 ;;; ;Write correspondence alist from ABSOLUTE unix path name to URL path.
24 ;;;
25 ;;;[インストール方法]
26 ;;;
27 ;;; yahtml.el, yatexlib.el, yatexprc.el を load-path の通ったディレクト
28 ;;; リにインストールしてください。その後、以下を参考に ~/.emacs に設定を
29 ;;; 追加して下さい。
30 ;;;
31 ;;; (setq auto-mode-alist
32 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))
33 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)
34 ;;; (setq yahtml-www-browser "firefox")
35 ;;; ;お気に入りのブラウザを書いて下さい。firefoxが便利です。
36 ;;; (setq yahtml-path-url-alist
37 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")
38 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))
39 ;;; ;UNIXの絶対パスと対応するURLのリストを書いて下さい。
40 ;;;
41 ;;; HTMLファイル漢字コードが正しく判別されるようにホームディレクトリに
42 ;;; .htaccess ファイルを作り以下のどれか1行を選んで書いて下さい。
43 ;;;
44 ;;; AddType "text/html; charset=Shift_JIS" .html (SJISの場合)
45 ;;; AddType "text/html; charset=iso2022-jp" .html (JISの場合)
46 ;;; AddType "text/html; charset=EUC-JP" .html (EUCの場合)
47 ;;; AddType "text/html; charset=utf-8" .html (UTF-8の場合)
48 ;;;
49 ;;; .htaccess が作れない場合は
50 ;;; (setq yahtml-kanji-code 2)
51 ;;; ;HTMLファイルの漢字コードを変更する場合は
52 ;;; ;1=SJIS、2=JIS、3=EUC 4=UTF-8
53 ;;; ;で設定して下さい。デフォルトは 4 です。
54 ;;;
55 ;;; を適切に書き換えて ~/.emacs に足して下さい。
56 ;;;
57 ;;;[Commentary]
58 ;;;
59 ;;; It is assumed you are already familiar with YaTeX. The following
60 ;;; completing featureas are available: ([prefix] means `C-c' by default)
61 ;;;
62 ;;; * [prefix] b X Complete environments such as `H1' which
63 ;;; normally requires closing tag `</H1>
64 ;;; <a href=foo> ... </a> is also classified into
65 ;;; this group
66 ;;; When input `href=...', you can complete file
67 ;;; name or label(href="#foo") by typing TAB.
68 ;;; * [prefix] l Complete typeface-changing commands such as
69 ;;; `<i> ... </i>' or `<samp> ... </samp>'
70 ;;; This completion can be used to make in-line
71 ;;; tags which is normally completed with [prefix] b.
72 ;;; * [prefix] s Complete declarative notations such as
73 ;;; `<img src="foo.gif">'
74 ;;; `<input name="var" ...>'
75 ;;; * [prefix] m Complete single commands such as
76 ;;; `<br>' or `<hr> or <li>...'
77 ;;; * [prefix] p Insert <p></p> on the point
78 ;;; * M-RET Intelligent newline; if current TAG is one of
79 ;;; ul, ol, or dl. insert newline and <li> or
80 ;;; <dt> or <dd> suitable for current condition.
81 ;;; * menu-bar yahtml Complete all by selecting a menu item (Though I
82 ;;; hate menu, this is most useful)
83 ;;; * [prefix] g Goto corresponding Tag or HREF such as
84 ;;; <dl> <-> </dl> or href="xxx".
85 ;;; Or invoke image viewer if point is on <img src=...>.
86 ;;; * [prefix] k Kill html tags on the point. If you provide
87 ;;; universal-argument, kill surrounded contents too.
88 ;;; * [prefix] c Change html tags on the point.
89 ;;; When typeing [prefix] c on `href="xxx"', you can
90 ;;; change the reference link with completion.
91 ;;; * [prefix] t j Call weblint on current file.
92 ;;; * [prefix] t p View current html with WWW browser
93 ;;; (To activate this, never fail to set the lisp
94 ;;; variable yahtml-www-browser. Recommended value
95 ;;; is "firefox")
96 ;;; * [prefix] a YaTeX's accent mark's equivalent of yahtml.
97 ;;; This function can input $lt, $gt or so.
98 ;;; * [prefix] ; Translate chars of `>', `<', `&', and `"' to
99 ;;; `&gt;', `&lt;', `&amp;', `&quot;' respectively
100 ;;; in the region.
101 ;;; * [prefix] : Do translation opposite to above, in the region.
102 ;;; * [prefix] # Translate unsafe-chars and unreserved-chars to
103 ;;; URLencoded string in the region.
104 ;;;
105 ;;;[キーの説明]
106 ;;;
107 ;;; 以下の説明において、特にカスタマイズをしていない限り、[prefix] は
108 ;;; C-c キーを意味します。
109 ;;;
110 ;;; * [prefix] b X `</H1>' といった終了タグが必要となる`H1'のよう
111 ;;; な環境を補完入力します。<a href=foo> ... </a>
112 ;;; もこのグループです。
113 ;;; `href=...' と入力した後、TABキーを押すことで、
114 ;;; ファイル名や (href="#foo") のようなラベルも補完
115 ;;; できます。
116 ;;; * [prefix] s 以下のような宣言の補完を行います。
117 ;;; `<img src="foo.gif">'
118 ;;; `<input name="var" ...>'
119 ;;; * [prefix] l `<i> ... </i>' や `<samp> ... </samp>' のよう
120 ;;; なテキストスタイル指定のタグを補完します。
121 ;;; この補完機能は通常 [prefix] b で補完できるものを
122 ;;; 一行内で書きたいときにも用いることが出来ます。
123 ;;; * [prefix] m `<br>' や `<hr> '、`<li>' 等の単体タグの補完
124 ;;; を行います。
125 ;;; * [prefix] p カーソル位置に<p></p>を挿入します。
126 ;;; * M-RET おまかせ改行; もしul、ol、dl等のタグ(リスト)を
127 ;;; 使っている場合に、環境に合わせて改行と <li>、
128 ;;; <dt>、<dd>を入力します。
129 ;;; * menu-bar yahtml 選択したアイテムをメニューより補完できます。
130 ;;; (私はメニューが嫌いなんですが、htmlに関してはメ
131 ;;; ニューは一番ありがたいかも)
132 ;;; * [prefix] g 対応するタグ、<dl> <-> </dl> や href="xxx" の
133 ;;; ような TAG にジャンプします。
134 ;;; <img src=...> の場合はイメージビューワを呼び出
135 ;;; します。href=hoge.html の場合はhoge.htmlに飛びま
136 ;;; す。
137 ;;; * [prefix] k ポイント上の HTML タグを消去します。
138 ;;; もし universal-argument を付けた場合(C-uを先に押
139 ;;; す)HTMLタグで囲まれた内容も同時に消去します。
140 ;;; * [prefix] c ポイント上のタグを変更します。
141 ;;; `href="xxx"'の上で [prefix] c を利用した場合は、
142 ;;; 参照しているリンクを補完機能を使いながら変更で
143 ;;; きます。
144 ;;; * [prefix] t j カレントファイルに対して jweblint を呼び出しま
145 ;;; す。ファイル先頭付近に
146 ;;; <!-- #lint コマンド -->
147 ;;; と書いておくとそのコマンドを呼びます。
148 ;;; * [prefix] t p WWW ブラウザでカレントファイルを表示します。
149 ;;; (lisp変数 yahtml-www-browser の設定をお忘れな
150 ;;; く。お推めは "firefox" です)
151 ;;; * [prefix] a YaTeX のアクセント記号補完と同じです。
152 ;;; &lt; &gt; 等が入力できます。
153 ;;; * [prefix] ; 指定したリジョン中の > < & " をそれぞれ
154 ;;; &gt; &lt; &amp; &quot; に変換します。
155 ;;; * [prefix] : 指定したリジョン中で上と逆の変換をします。
156 ;;; * [prefix] # 指定したリジョン中で%エンコードの必要な文字が
157 ;;; あればそれらをエンコードします。
158 ;;; * [prefix] } リジョン内の特定文字区切りのレコードを <td> 並びに
159 ;;; 変換します。C-u (universal-argument) 付きで起動
160 ;;; するとtd以外の任意要素で括ります。thdを指定する
161 ;;; と最初の1つだけth,残りすべてをtdで括ります。
162 ;;; * [prefix] ] リジョン内のすべての行をフィールドごとにtdで括り,
163 ;;; さらに各行をtrで括ります。universal-argument を
164 ;;; 付けるとフィールド括りをtd以外に指定できます。
165 ;;; * [prefix] ESC yahtml-mode を抜け yahtml-mode に入る前に動作し
166 ;;; ていたメジャーモードに戻ります。
167 ;;;
168 ;;; [謝辞]
169 ;;;
170 ;;; fj野鳥の会の皆さんには貴重な助言を頂きました。また、下に示す方々には
171 ;;; 特に大きな協力を頂きました。あわせてここに感謝申し上げます。
172 ;;;
173 ;;; * 横田和也さん(マツダ)
174 ;;; マニュアルの和訳をして頂きました。
175 ;;; * 吉田尚志さん(NTT Data)
176 ;;; Mule for Win32 での動作のさせ方を教えて頂きました。
177 ;;; (というかほとんどやってもらった ^^;)
178 ;;;
180 ;;; Code:
182 (require 'yatexlib)
183 ;;; --- customizable variable starts here ---
184 (defvar yahtml-prefix "\C-c"
185 "*Prefix key stroke of yahtml functions.")
186 (defvar yahtml-image-viewer "display" "*Image viewer program")
187 (defvar yahtml-www-browser "firefox" "*WWW Browser command")
188 (defvar yahtml-kanji-code 4
189 "*Kanji coding system number of html file; 1=sjis, 2=jis, 3=euc, 4=UTF-8")
190 ;;(defvar yahtml-coding-system
191 ;; (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))
192 ;; "Kanji coding system")
193 (and (featurep 'mule)
194 (integerp yahtml-kanji-code)
195 (setq yahtml-kanji-code
196 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))))
198 (defvar yahtml-fill-column 72 "*fill culumn used for yahtml-mode")
199 (defvar yahtml-fill-prefix nil "*fill prefix for yahtml-mode")
201 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")
202 (defvar yahtml-path-url-alist nil
203 "*Alist of unix path name vs. URL name of WWW server.
204 Ex.
205 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")
206 (\"/home/yuuji/http\" . \"http://www.gentei.org/~yuuji\"))")
207 (defvar yahtml-directory-index "index.html"
208 "*Directory index file name;
209 Consult your site's WWW administrator.")
211 (defvar yahtml-environment-indent 1
212 "*Indentation depth of HTML's listing environment")
214 ;; YaTeX-japan is defined in yatexlib.el
215 (defvar yahtml-lint-program (if YaTeX-japan "jweblint" "weblint")
216 "*Program name to lint HTML file")
217 (defvar yahtml-hate-too-deep-indentation nil
218 "*Non-nil for this variable suppress deep indentation in listing environments.")
220 (defvar yahtml-always-/p t
221 "*Those who always use <p> with </p> set this to t.")
222 (defvar yahtml-always-/li nil
223 "*Those who always use <li> with </li> set this to t.")
224 (defvar yahtml-always-/dt nil
225 "*Those who always use <dt> with </dt> set this to t.")
226 (defvar yahtml-always-/dd nil
227 "*Those who always use <dd> with </dd> set this to t.")
229 (defvar yahtml-p-prefered-env-regexp "^\\(body\\|dl\\|blockquote\\)"
230 "*Regexp of envs where paragraphed sentences are prefered.")
232 (defvar yahtml-template-file "~/public_html/template.html"
233 "*Template HTML file. It'll be inserted to empty file.")
235 (defvar yahtml-prefer-upcases nil
236 "*Non-nil for preferring upcase TAGs")
238 (defvar yahtml-prefer-upcase-attributes nil
239 "*Non-nil for preferring upcase attributes")
241 (defvar yahtml-server-type 'apache "*WWW server program type")
243 (defvar yahtml-apache-access-file ".htaccess"
244 "*Server access file name for apache")
246 (defvar yahtml-use-css t "*Use stylesheet or not")
248 (defvar yahtml-image-inspection-bytes 500000
249 "*Number of bytes to inspect the image for geometry information")
250 (defvar yahtml:img-default-alt-format "%xx%y(%sbytes)"
251 "*Default format of img entity's ALT attributes.
252 %x: width, %y: height, %s: size in bytes, %c: first comment string,
253 %f: filename")
255 (defvar yahtml-faithful-to-htmllint yahtml-always-/li
256 "*Non-nil doesn't put space after opening tags.")
258 (defvar yahtml-error-line-regexp
259 "^\\(.*\\)(\\([0-9]+\\)):\\|^line \\([0-9]+\\)"
260 "*Regexp of error position which is produced by lint program.")
262 (defvar yahtml-translate-hyphens-when-comment-region t
263 "*Non-nil for translate hyphens to &#45; when comment-region")
264 (defvar yahtml-escape-chars 'ask
265 "*Escape reserved characters to URL-encoding or not.
266 Nil for never, t for everytime, and 'ask for inquiring
267 at each reserved chars.")
269 (defvar yahtml-use-font-lock (and (featurep 'font-lock)
270 (fboundp 'font-lock-fontify-region))
271 "*Non-nil means to use font-lock to fontify buffer.")
273 (defvar yahtml-use-hilit19 (and (featurep 'hilit19)
274 (not yahtml-use-font-lock))
275 "*Non-nil means to Use hilit19 to highlight buffer")
277 (defvar yahtml-mode-abbrev-table nil
278 "*Abbrev table in use in yahtml-mode buffers.")
279 (define-abbrev-table 'yahtml-mode-abbrev-table ())
281 (defvar yahtml-indentation-boundary "^\\s *<h[1-3]>"
282 "*Boundary regexp for indentation calculation.")
284 (defvar yahtml-html4-strict t
285 "*Non-nil means editing HTML 4.01 Strict.
286 Completing read for obsoleted attributes disabled.")
288 (defvar yahtml-electric-indent-mode -1
289 "*(Emacs 24.4+) Pass this value to electric-indent-local-mode.
290 -1 means `off'.")
292 ;;; --- customizable variable ends here ---
293 (defvar yahtml-prefix-map nil)
294 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")
295 (defvar yahtml-lint-buffer-map nil "Keymap used in lint buffer.")
296 (defvar yahtml-shell-command-option
297 (or (and (boundp 'shell-command-option) shell-command-option)
298 (if (eq system-type 'ms-dos) "/c" "-c")))
299 (defvar yahtml-use-highlighting (or yahtml-use-font-lock yahtml-use-hilit19))
301 (defun yahtml-define-begend-key-normal (key env &optional map)
302 "Define short cut yahtml-insert-begend key."
303 (YaTeX-define-key
304 key
305 (list 'lambda '(arg) '(interactive "P")
306 (list 'yahtml-insert-begend 'arg env))
307 map))
309 (defun yahtml-define-begend-region-key (key env &optional map)
310 "Define short cut yahtml-insert-begend-region key."
311 (YaTeX-define-key key (list 'lambda nil '(interactive)
312 (list 'yahtml-insert-begend t env)) map))
314 (defun yahtml-define-begend-key (key env &optional map)
315 "Define short cut key for begin type completion both for
316 normal and region mode. To customize yahtml, user should use this function."
317 (yahtml-define-begend-key-normal key env map)
318 (if YaTeX-inhibit-prefix-letter nil
319 (yahtml-define-begend-region-key
320 (concat (upcase (substring key 0 1)) (substring key 1)) env map)))
322 (if yahtml-mode-map nil
323 (setq yahtml-mode-map (make-sparse-keymap)
324 yahtml-prefix-map (make-sparse-keymap))
325 (define-key yahtml-mode-map yahtml-prefix yahtml-prefix-map)
326 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)
327 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)
328 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))
329 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)
330 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)
331 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)
332 (define-key yahtml-mode-map "\M-\C-j" 'yahtml-intelligent-newline)
333 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)
334 (define-key yahtml-mode-map "&" 'yahtml-insert-amps)
335 (let ((map yahtml-prefix-map))
336 (YaTeX-define-key "^" 'yahtml-visit-main map)
337 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)
338 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)
339 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)
340 (and YaTeX-emacs-19 window-system
341 (progn
342 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
343 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
344 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
345 (YaTeX-define-key "v" 'yahtml-version map)
346 (YaTeX-define-key "s" 'yahtml-insert-form map)
347 (YaTeX-define-key "l" 'yahtml-insert-tag map)
348 (YaTeX-define-key "L" 'yahtml-insert-tag-region map)
349 (YaTeX-define-key "m" 'yahtml-insert-single map)
350 (YaTeX-define-key "n" (function(lambda () (interactive) (insert (if yahtml-prefer-upcases "<BR>" "<br>")))) map)
351 (YaTeX-define-key "-" (function(lambda () (interactive) (insert (if yahtml-prefer-upcases "<HR>" "<hr>") "\n"))) map)
352 (YaTeX-define-key "p" 'yahtml-insert-p map)
353 (if YaTeX-no-begend-shortcut
354 (progn
355 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)
356 (YaTeX-define-key "b" 'yahtml-insert-begend map))
357 (yahtml-define-begend-key "bh" "html" map)
358 (yahtml-define-begend-key "bH" "head" map)
359 (yahtml-define-begend-key "bt" "title" map)
360 (yahtml-define-begend-key "bT" "table" map)
361 (yahtml-define-begend-key "bb" "body" map)
362 (yahtml-define-begend-key "bc" "center" map)
363 (yahtml-define-begend-key "bd" "dl" map)
364 (yahtml-define-begend-key "bD" "div" map)
365 (yahtml-define-begend-key "bu" "ul" map)
366 (yahtml-define-begend-key "bo" "ol" map)
367 (yahtml-define-begend-key "b1" "h1" map)
368 (yahtml-define-begend-key "b2" "h2" map)
369 (yahtml-define-begend-key "b3" "h3" map)
370 (yahtml-define-begend-key "ba" "a" map)
371 (yahtml-define-begend-key "bf" "form" map)
372 (yahtml-define-begend-key "bl" "label" map)
373 (yahtml-define-begend-key "bs" "select" map)
374 (yahtml-define-begend-key "bv" "div" map)
375 (yahtml-define-begend-key "bS" "span" map)
376 (yahtml-define-begend-key "bp" "pre" map)
377 (yahtml-define-begend-key "bq" "blockquote" map)
378 (YaTeX-define-key "b " 'yahtml-insert-begend map)
379 (YaTeX-define-key "B " 'yahtml-insert-begend-region map))
380 (YaTeX-define-key "e" 'YaTeX-end-environment map)
381 (YaTeX-define-key ">" 'yahtml-comment-region map)
382 (YaTeX-define-key "<" 'yahtml-uncomment-region map)
383 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)
384 (YaTeX-define-key "k" 'yahtml-kill-* map)
385 (YaTeX-define-key "c" 'yahtml-change-* map)
386 (YaTeX-define-key "t" 'yahtml-browse-menu map)
387 (YaTeX-define-key "a" 'yahtml-char-entity-ref map)
388 (YaTeX-define-key "'" 'yahtml-prev-error map)
389 (YaTeX-define-key ";" 'yahtml-translate-region map)
390 (YaTeX-define-key ":" 'yahtml-translate-reverse-region map)
391 (YaTeX-define-key "#" 'yahtml-escape-chars-region map)
392 (YaTeX-define-key "}" 'yahtml-td-region map)
393 (YaTeX-define-key "]" 'yahtml-tr-region map)
394 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
395 (YaTeX-define-key "\e" 'yahtml-quit map))
396 (substitute-all-key-definition
397 'fill-paragraph 'yahtml-fill-paragraph yahtml-mode-map)
398 (substitute-all-key-definition
399 'kill-buffer 'YaTeX-kill-buffer yahtml-mode-map))
401 (if yahtml-lint-buffer-map nil
402 (setq yahtml-lint-buffer-map (make-keymap))
403 (define-key yahtml-lint-buffer-map " " 'yahtml-jump-to-error-line))
406 (defvar yahtml-paragraph-start
407 (concat
408 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|[bhtd][rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\)\\b")
409 "*Regexp of html paragraph separater")
410 (defvar yahtml-paragraph-separate
411 (concat
412 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|[bhtd][ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\|!--\\)\\b")
413 "*Regexp of html paragraph separater")
414 (defvar yahtml-syntax-table nil
415 "*Syntax table for yahtml-mode")
417 (if yahtml-syntax-table nil
418 (setq yahtml-syntax-table
419 (make-syntax-table (standard-syntax-table)))
420 (modify-syntax-entry ?\< "(>" yahtml-syntax-table)
421 (modify-syntax-entry ?\> ")<" yahtml-syntax-table)
422 (modify-syntax-entry ?\n " " yahtml-syntax-table))
424 (defvar yahtml-command-regexp "[A-Za-z0-9]+"
425 "Regexp of constituent of html commands.")
427 ;;; Completion tables for `form'
428 (defvar yahtml-form-table
429 '(("img") ("input") ("link") ("meta") ("label") ("source")))
430 (defvar yahtml-user-form-table nil)
431 (defvar yahtml-tmp-form-table nil)
432 (defvar yahtml-last-form "img")
434 (defvar yahtml-env-table
435 '(("html") ("head") ("title") ("body") ("dl") ("ul") ("ol") ("pre")
436 ("a") ("form") ("select") ("center") ("textarea") ("blockquote")
437 ("OrderedList" . "ol")
438 ("UnorderedList" . "ul")
439 ("DefinitionList" . "dl")
440 ("Preformatted" . "pre")
441 ("table") ("thead") ("tbody") ("tfoot") ("tr") ("th") ("td")
442 ("address") ("button")
443 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6")
444 ;; ("p") ;This makes indentation screwed up!
445 ("style") ("script") ("noscript") ("div") ("object") ("ins") ("del")
446 ("option") ("datalist")
447 ;;HTML5
448 ("video") ("audio") ("figure") ("iframe")
449 ("header") ("footer") ("article") ("section") ("nav") ("main") ("aside")
450 ("meter") ("progress")
451 ))
453 (if yahtml-html4-strict
454 (setq yahtml-env-table
455 (delete (assoc "center" yahtml-env-table) yahtml-env-table)))
457 ;(defvar yahtml-itemizing-regexp
458 ; "\\(ul\\|ol\\|dl\\)"
459 ; "Regexp of itemizing forms")
461 (defvar yahtml-user-env-table nil)
462 (defvar yahtml-tmp-env-table nil)
464 ;;; Completion tables for typeface designator
465 (and yahtml-always-/p
466 (or (assoc "p" yahtml-env-table)
467 (setq yahtml-env-table (cons '("p") yahtml-env-table))))
468 (and yahtml-always-/li
469 (or (assoc "li" yahtml-env-table)
470 (setq yahtml-env-table (cons '("li") yahtml-env-table))))
471 (and yahtml-always-/dt
472 (or (assoc "dt" yahtml-env-table)
473 (setq yahtml-env-table (cons '("dt") yahtml-env-table))))
474 (and yahtml-always-/dd
475 (or (assoc "dd" yahtml-env-table)
476 (setq yahtml-env-table (cons '("dd") yahtml-env-table))))
478 (defvar yahtml-typeface-table
479 (append
480 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("caption")
481 ("strong") ("var") ("b") ("i") ("tt") ("big") ("small")
482 ("sup") ("sub") ("span") ("abbr") ("label")
483 ;; HTML5
484 ("figcaption")
485 )
486 (if (not yahtml-html4-strict)
487 '(("strike") ("s") ("u") ("font")))
488 yahtml-env-table)
489 "Default completion table of typeface designator")
490 (defvar yahtml-user-typeface-table nil)
491 (defvar yahtml-tmp-typeface-table nil)
492 (defvar yahtml-last-typeface-cmd "a")
494 (defvar yahtml-single-cmd-table
495 '(("hr") ("br") ("option")
496 ("HorizontalRule" . "hr")
497 ("BreakLine" . "br")
498 ("exec" . "!--#exec")
499 ("!--#exec")
500 ("include" . "!--#include")
501 ("!--#include")
502 ;; ("Item" . "li")
503 ;; ("DefineTerm" . "dt")
504 ;; ("Description" . "dd")
505 ;; ("dd") ("dt") ("li")
506 )
507 "Default completion table of HTML single command.")
508 (defvar yahtml-user-single-cmd-table nil)
509 (defvar yahtml-tmp-single-cmd-table nil)
510 (defvar yahtml-last-single-cmd nil)
512 (defvar yahtml-current-completion-type nil
513 "Has current completion type. This may be used in yahtml addin functions.")
515 (defvar yahtml-struct-name-regexp
516 (concat
517 "\\<\\("
518 ;(mapconcat 'car yahtml-typeface-table "\\|")
519 (mapconcat 'car yahtml-env-table "\\|")
520 "\\)\\b")
521 "Regexp of structure beginning.")
523 (defvar yahtml-closable-regexp
524 (concat
525 "\\<\\("
526 (mapconcat 'car yahtml-typeface-table "\\|")
527 (mapconcat 'car yahtml-env-table "\\|")
528 "\\)\\b")
529 "Regexp of any closable elemnts.")
531 (defvar yahtml-indent-listing-constant t
532 "*Nil means indentation for listing obeys the column of `>'.
533 T for static indentation depth")
535 (or (assoc "p" yahtml-env-table)
536 (setq yahtml-env-table (cons '("p") yahtml-env-table)))
539 (defun yahtml-get-user-httpconf-entry (regexp)
540 (cond
541 ((and (eq yahtml-server-type 'apache) ;;check .htaccess
542 buffer-file-name)
543 (let ((dir default-directory)
544 charset af ext (ldir "")
545 line
546 (case-fold-search t)
547 (uid (car (cdr (cdr (file-attributes "."))))))
548 (if (string-match "^[A-Z]:" dir)
549 (setq dir (substring dir 2))) ;remove drive letter
550 (while (and dir
551 (not (string= dir ldir))
552 (equal uid (car (cdr (cdr (file-attributes dir))))))
553 (setq af (expand-file-name yahtml-apache-access-file dir))
554 (if (file-exists-p af)
555 (save-excursion
556 (set-buffer (find-file-noselect af))
557 (save-excursion
558 (goto-char (point-min))
559 (if (re-search-forward regexp nil t)
560 (setq line (buffer-substring
561 (point-beginning-of-line)
562 (point-end-of-line))
563 dir nil)))
564 (kill-buffer (current-buffer))))
565 (if dir
566 (setq ldir dir
567 dir (substring dir 0 (string-match "/$" dir))
568 dir (file-name-directory dir))))
569 line))
570 (t nil)))
572 (defun yahtml-dir-default-charset ()
573 (let*((fn (file-name-nondirectory (or buffer-file-name "")))
574 (ext (substring fn (or (string-match "\\.[a-z0-9]+$" fn) 0)))
575 (ptn (format "^\\s *AddType.*charset=\\(.*\\)\\%s\\>" ext))
576 (case-fold-search t)
577 line
578 charset)
579 (if (setq line (yahtml-get-user-httpconf-entry ptn))
580 (progn
581 (string-match ptn line)
582 (setq charset
583 (substring line (match-beginning 1) (match-end 1)))
584 (cond
585 ((string-match "iso-2022-jp" charset)
586 (setq charset 2))
587 ((string-match "euc-jp" charset)
588 (setq charset 3))
589 ((string-match "shift_jis" charset)
590 (setq charset 1))
591 ((string-match "utf-8" charset)
592 (setq charset 4))
593 (t (setq charset nil)))
594 (setq dir "")))
595 (if (featurep 'mule)
596 (setq charset (cdr (assq charset YaTeX-kanji-code-alist))))
597 charset))
599 (defun yahtml-get-directory-index ()
600 (let ((line (yahtml-get-user-httpconf-entry "^\\s *DirectoryIndex"))
601 x index-list)
602 ;;s/\\s *$//;
603 (if line
604 (progn
605 (if (string-match "DirectoryIndex\\s +\\(.*\\)\\s *$" line)
606 (setq line (substring line (match-beginning 1) (match-end 1))))
607 (while (string< "" line)
608 (if (setq x (string-match "\\(\\s +\\)" line))
609 (setq index-list (cons (substring line 0 x) index-list)
610 line (substring line (match-end 1)))
611 (setq index-list (cons line index-list)
612 line "")))
613 (or (nreverse index-list)
614 (if (listp yahtml-directory-index)
615 yahtml-directory-index
616 (list yahtml-directory-index)))))))
618 (defvar yahtml-mode-old-mode nil)
619 (defun yahtml-mode ()
620 (interactive)
621 (let ((old-mm major-mode)) ;Emacs21.0.95 resets major-mode
622 (kill-all-local-variables) ;with kill-all-local-variables
623 (if (not (eq 'yahtml-mode old-mm))
624 (set (make-local-variable 'yahtml-mode-old-mode) old-mm)))
625 (let ((coding (or (yahtml-dir-default-charset) yahtml-kanji-code)))
626 (cond
627 ((null coding) nil)
628 ((and YaTeX-emacs-20 (boundp 'buffer-file-coding-system))
629 (setq buffer-file-coding-system
630 (or (and (fboundp 'set-auto-coding) buffer-file-name
631 (save-excursion
632 (goto-char (point-min))
633 (set-auto-coding buffer-file-name (buffer-size))))
634 coding)))
635 ((featurep 'mule)
636 (set-file-coding-system coding))
637 ((boundp 'NEMACS)
638 (make-local-variable 'kanji-fileio-code)
639 (setq kanji-fileio-code coding))))
640 (setq major-mode 'yahtml-mode
641 mode-name "yahtml"
642 YaTeX-current-file-name (file-name-nondirectory
643 (or (buffer-file-name) ""))
644 local-abbrev-table yahtml-mode-abbrev-table)
645 (mapcar
646 (function (lambda (x)
647 (make-local-variable (car x))
648 (set (car x) (if (and (symbolp (cdr x))
649 (boundp (cdr x)))
650 (symbol-value (cdr x))
651 (cdr x)))))
652 '((YaTeX-ec . "")
653 (YaTeX-struct-begin . "<%1%2")
654 (YaTeX-struct-end . "</%1>")
655 (YaTeX-struct-name-regexp . yahtml-closable-regexp)
656 (YaTeX-comment-prefix . "<!--[^#]")
657 (YaTeX-coding-system . yahtml-kanji-code) ;necessary?
658 (YaTeX-typesetting-mode-map . yahtml-lint-buffer-map)
659 (fill-prefix . yahtml-fill-prefix) (fill-column . yahtml-fill-column)
660 (paragraph-start . yahtml-paragraph-start)
661 (paragraph-separate . yahtml-paragraph-separate)
662 (comment-start . "<!-- ") (comment-end . " -->")
663 (comment-start-skip . comment-start)
664 (indent-line-function . yahtml-indent-line)))
666 (if yahtml-use-font-lock
667 (progn
668 (yahtml-font-lock-set-default-keywords)
669 (or (featurep 'xemacs)
670 (progn
671 (set (make-local-variable 'font-lock-defaults)
672 '(yahtml-font-lock-keywords nil t))
673 ;;(font-lock-mode -1)
674 (font-lock-mode 1) ;;Why should I fontify again???
675 ;; in yatex-mode, there's no need to refontify...
676 (font-lock-fontify-buffer)))))
677 ;; +dnd for X11 w/ emacs23+
678 (and window-system (featurep 'dnd)
679 (set (make-local-variable 'dnd-protocol-alist)
680 (cons (cons "^\\(file\\|https?\\):" 'yahtml-dnd-handler)
681 dnd-protocol-alist)))
683 (set-syntax-table yahtml-syntax-table)
684 (use-local-map yahtml-mode-map)
685 (YaTeX-read-user-completion-table)
686 (yahtml-css-scan-styles)
687 ;(turn-on-auto-fill) ;Sorry, this is prerequisite
688 (and (= 0 (buffer-size)) (file-exists-p yahtml-template-file)
689 (y-or-n-p (format "Insert %s?" yahtml-template-file))
690 (insert-file-contents (expand-file-name yahtml-template-file)))
691 (if (fboundp 'electric-indent-local-mode)
692 (electric-indent-local-mode yahtml-electric-indent-mode))
693 (run-hooks 'text-mode-hook 'yahtml-mode-hook)
695 ;; This warning should be removed after a while(2000/12/2)
696 (let ((fld (or (and (local-variable-p 'font-lock-defaults (current-buffer))
697 font-lock-defaults)
698 (get 'yahtml-mode 'font-lock-defaults))))
699 (and fld (not (memq 'yahtml-font-lock-keywords fld))
700 (YaTeX-warning-font-lock "yahtml"))))
702 (defun yahtml-version ()
703 "Return string of the version of running yahtml."
704 (interactive)
705 (message
706 (concat "Yet Another HTML-mode "
707 (if YaTeX-japan "「HTML屋」" "`yahtml'")
708 " Revision "
709 yahtml-revision-number)))
711 (defun yahtml-quit ()
712 (interactive)
713 (and yahtml-mode-old-mode
714 (fboundp yahtml-mode-old-mode)
715 (funcall yahtml-mode-old-mode)))
717 (defun yahtml-define-menu (keymap bindlist)
718 (cond
719 ((featurep 'xemacs)
720 (let ((name (keymap-name (symbol-value keymap))))
721 (set keymap nil)
722 (mapcar
723 (function
724 (lambda (bind)
725 (setq bind (cdr bind))
726 (if (eq (car (cdr bind)) 'lambda)
727 (setcar (cdr bind) 'progn))
728 (if (stringp (car (cdr bind)))
729 (set keymap (cons (cdr bind) (symbol-value keymap)))
730 (set keymap (cons (vector (car bind) (cdr bind) t)
731 (symbol-value keymap))))))
732 bindlist)
733 (set keymap (cons name (symbol-value keymap)))))
734 (t
735 (mapcar
736 (function
737 (lambda (bind)
738 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
739 bindlist))))
741 (defvar yahtml-menu-map nil "Menu map of yahtml")
742 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")
743 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")
744 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")
745 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")
747 ;;; Variables for mosaic url history
748 (defvar yahtml-urls nil "Alist of global history")
749 (defvar yahtml-urls-private nil)
750 (defvar yahtml-urls-local nil)
752 (cond
753 ((and YaTeX-emacs-19 (null yahtml-menu-map))
754 (setq yahtml-menu-map (make-sparse-keymap "yahtml"))
755 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))
756 (YaTeX-define-menu
757 'yahtml-menu-map-sectioning
758 (nreverse
759 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))
760 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))
761 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))
762 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))
763 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))
764 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))
765 )))
766 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))
767 (YaTeX-define-menu
768 'yahtml-menu-map-logical
769 (nreverse
770 '((em "Embolden" .
771 (lambda () (interactive) (yahtml-insert-tag nil "EM")))
772 (dfn "Define a word" .
773 (lambda () (interactive) (yahtml-insert-tag nil "DFN")))
774 (cite "Citation" .
775 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))
776 (code "Code" .
777 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))
778 (kbd "Keyboard" .
779 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))
780 (samp "Sample display" .
781 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))
782 (strong "Strong" .
783 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))
784 (VAR "Variable notation" .
785 (lambda () (interactive) (yahtml-insert-tag nil "var"))))))
786 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))
787 (YaTeX-define-menu
788 'yahtml-menu-map-typeface
789 (nreverse
790 '((b "Bold" .
791 (lambda () (interactive) (yahtml-insert-tag nil "b")))
792 (i "Italic" .
793 (lambda () (interactive) (yahtml-insert-tag nil "i")))
794 (tt "Typewriter" .
795 (lambda () (interactive) (yahtml-insert-tag nil "tt")))
796 (u "Underlined" .
797 (lambda () (interactive) (yahtml-insert-tag nil "u"))))))
798 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))
799 (YaTeX-define-menu
800 'yahtml-menu-map-listing
801 (nreverse
802 '((ul "Unordered" .
803 (lambda () (interactive) (yahtml-insert-begend nil "ul")))
804 (ol "Ordered" .
805 (lambda () (interactive) (yahtml-insert-begend nil "ol")))
806 (dl "Definition" .
807 (lambda () (interactive) (yahtml-insert-begend nil "dl"))))))
808 (setq yahtml-menu-map-item (make-sparse-keymap "item"))
809 (YaTeX-define-menu
810 'yahtml-menu-map-item
811 (nreverse
812 '((li "Simple item" .
813 (lambda () (interactive) (yahtml-insert-single "li")))
814 (dt "Define term" .
815 (lambda () (interactive) (yahtml-insert-single "dt")))
816 (dd "Description of term" .
817 (lambda () (interactive) (yahtml-insert-single "dd"))))))
818 (define-key yahtml-mode-map [menu-bar yahtml]
819 (cons "yahtml" yahtml-menu-map))
820 (YaTeX-define-menu
821 'yahtml-menu-map
822 (nreverse
823 (list
824 (cons (list 'sect "Sectioning")
825 (cons "sectioning" yahtml-menu-map-sectioning))
826 (cons (list 'list "Listing")
827 (cons "Listing" yahtml-menu-map-listing))
828 (cons (list 'item "Item")
829 (cons "Itemizing" yahtml-menu-map-item));;;
830 (cons (list 'logi "Logical tags")
831 (cons "logical" yahtml-menu-map-logical))
832 (cons (list 'type "Typeface tags")
833 (cons "typeface" yahtml-menu-map-typeface)))))
834 (if (featurep 'xemacs)
835 (add-hook 'yahtml-mode-hook
836 (function
837 (lambda ()
838 (or (assoc "yahtml" current-menubar)
839 (progn
840 (set-buffer-menubar (copy-sequence current-menubar))
841 (add-submenu nil yahtml-menu-map)))))))))
843 ;;; ----------- Completion ----------
844 (defvar yahtml-last-begend "html")
845 (defun yahtml-insert-begend (&optional region env)
846 "Insert <cmd> ... </cmd>."
847 (interactive "P")
848 (setq yahtml-current-completion-type 'multiline
849 region (or region (YaTeX-region-active-p)))
850 (let*((completion-ignore-case t)
851 (cmd
852 (or env
853 (YaTeX-cplread-with-learning
854 (format "Environment(default %s): " yahtml-last-begend)
855 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))
856 (bolp (save-excursion
857 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))
858 (cc (current-column)))
859 (if (string< "" cmd) (setq yahtml-last-begend cmd))
860 (setq yahtml-last-begend
861 (or (cdr (assoc yahtml-last-begend yahtml-env-table))
862 yahtml-last-begend))
863 (setq cmd yahtml-last-begend)
864 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase) cmd))
865 (if region
866 ;; We want to keep region effective for new tagged environment
867 ;; to enable continuous regioning by another environment
868 (let ((beg (region-beginning))
869 (end (region-end))
870 (addin (yahtml-addin cmd)))
871 (save-excursion
872 (goto-char end)
873 (insert-before-markers (format "</%s>%s" cmd (if bolp "\n" "")))
874 (goto-char beg)
875 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" "")))))
876 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))
877 (save-excursion
878 (insert "\n")
879 (indent-to-column cc)
880 (insert (format "</%s>" cmd)))
881 (if (string-match "^[ap]$" cmd) ;aとp決め打ちってのが美しくない…
882 (newline)
883 (yahtml-intelligent-newline nil))
884 (yahtml-indent-line))))
886 (defun yahtml-insert-begend-region ()
887 "Call yahtml-insert-begend in the region mode."
888 (interactive)
889 (yahtml-insert-begend t))
892 (defun yahtml-insert-form (&optional form)
893 "Insert <FORM option=\"argument\">."
894 (interactive)
895 (setq yahtml-current-completion-type 'single)
896 (or form
897 (let ((completion-ignore-case t))
898 (setq form
899 (YaTeX-cplread-with-learning
900 (format "Form(default %s): " yahtml-last-form)
901 'yahtml-form-table 'yahtml-user-form-table
902 'yahtml-tmp-form-table))))
903 (let ((p (point)) q)
904 (if (string= form "") (setq form yahtml-last-form))
905 (setq yahtml-last-form form)
906 (if yahtml-prefer-upcases (setq form (upcase form)))
907 (insert (format "<%s%s>" form (yahtml-addin form)))
908 ;;(indent-relative-maybe)
909 (if (cdr (assoc form yahtml-form-table))
910 (save-excursion (insert (format "</%s>" form))))
911 (if (search-backward "\"\"" p t) (forward-char 1))))
913 (defun yahtml-read-css (alist &optional element)
914 (let ((completion-ignore-case t) (delim " ")
915 (minibuffer-completion-table alist)
916 (quotekey (substitute-command-keys "\\[quoted-insert]")))
917 (read-from-minibuffer-with-history
918 (if YaTeX-japan
919 (format "%sクラス(複数指定は%s SPCで区切る): "
920 (if element (concat element "の") "") quotekey)
921 (format "class%s(multiple class can be delimited by %s SPC): "
922 (if element (concat " for " element) "") quotekey))
923 nil YaTeX-minibuffer-completion-map nil)))
925 (defvar yahtml-newpage-command "newpage.rb"
926 "*Command name to create new HTML file referring to index.html.
927 This command should create new HTML file named argument 1 and
928 output string like `<a href=\"newfile.html\">anchor tag</a>'.
929 This program should take -o option to overwrite existing HTML file.")
930 (defun yahtml-newpage (file ov)
931 "Create newpage via newpage script"
932 (interactive
933 (list
934 (let (insert-default-directory)
935 (read-file-name "New webpage file name: " ""))
936 current-prefix-arg))
937 (if (and (file-exists-p file) (not ov))
938 (error "%s already exists. Call this with universal argument to force overwrite." file))
939 (insert (substring
940 (YaTeX-command-to-string
941 (concat yahtml-newpage-command " " (if ov "-o ") file))
942 0 -1)))
944 ;;; ---------- Add-in ----------
945 (defun yahtml-addin (form)
946 "Check add-in function's existence and call it if exists."
947 (let ((addin (concat "yahtml:" (downcase form))) s a)
948 (concat
949 (and (setq a (yahtml-css-get-element-completion-alist form))
950 (not (equal (YaTeX-last-key) ?\C-j))
951 (memq yahtml-current-completion-type '(multiline inline))
952 (not (string-match "#\\|source" form))
953 (yahtml-make-optional-argument ;should be made generic?
954 "class" (yahtml-read-css a form)))
955 (if (and (intern-soft addin) (fboundp (intern-soft addin))
956 (stringp (setq s (funcall (intern addin))))
957 (string< "" s))
958 (if (eq (aref s 0) ? ) s (concat " " s))
959 ""))))
961 (defvar yahtml-completing-buffer nil)
962 (defun yahtml-collect-labels (&optional file ptn withouthash)
963 "Collect current buffers label (<?? name=...>).
964 If optional argument FILE is specified collect labels in FILE."
965 (let ((attrptn (concat "\\(" (or ptn "name\\|id") "\\)\\s *="))
966 (hash (if withouthash "" "#"))
967 list end)
968 (save-excursion
969 (set-buffer (or yahtml-completing-buffer (current-buffer)))
970 (if file (let (hilit-auto-highlight)
971 (set-buffer (find-file-noselect file))))
972 (save-excursion
973 (goto-char (point-min))
974 (while ;(re-search-forward "<\\w+\\b" nil t)
975 (re-search-forward attrptn nil t)
976 ;(setq bound (match-end 0))
977 ;(search-forward ">" nil t)
978 (setq end (match-end 0))
979 (if (and ;(re-search-backward "\\(name\\|id\\)\\s *=" bound t)
980 (yahtml-on-assignment-p)
981 (progn
982 (goto-char end)
983 (skip-chars-forward " \t\n")
984 (looking-at "\"?#?\\([^\">]+\\)\"?\\b")))
985 (setq list (cons
986 (list (concat hash (YaTeX-match-string 1)))
987 list))))
988 list))))
990 (defun yahtml-collect-ids (&optional file)
991 (yahtml-collect-labels file "id" 'withouthash))
993 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")
994 (if yahtml-url-completion-map nil
995 (setq yahtml-url-completion-map
996 (copy-keymap minibuffer-local-completion-map))
997 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)
998 (define-key yahtml-url-completion-map " " 'yahtml-complete-url))
1000 (defun yahtml-complete-url ()
1001 "Complete external URL from history or local file name."
1002 (interactive)
1003 (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels
1004 (lim (YaTeX-minibuffer-begin))
1005 (min (if (fboundp 'field-beginning) (field-beginning) (point-min))))
1006 (setq initial (YaTeX-minibuffer-string))
1007 (cond
1008 ((string-match "^htt" initial)
1009 (setq cmpl (try-completion initial yahtml-urls)
1010 listfunc (list 'lambda nil
1011 (list 'all-completions initial 'yahtml-urls))
1012 beg min))
1013 ((setq beg (string-match "#" initial))
1014 (or (equal beg 0) ;begin with #
1015 (progn
1016 (setq path (substring initial 0 beg))
1017 (if (string-match "^/" path)
1018 (setq path (yahtml-url-to-path path)))))
1019 (setq initial (substring initial beg))
1020 (setq labels (yahtml-collect-labels path)
1021 cmpl (try-completion initial labels)
1022 listfunc (list 'lambda ()
1023 (list 'all-completions
1024 initial (list 'quote labels)))
1025 beg (+ min beg)))
1026 (t
1027 (setq path (if (string-match "^/" initial)
1028 (or (yahtml-url-to-path initial) initial)
1029 initial))
1030 (setq dir (or (file-name-directory path) ".")
1031 file (file-name-nondirectory path)
1032 initial file
1033 cmpl (file-name-completion file dir)
1034 listfunc (list 'lambda nil
1035 (list 'file-name-all-completions
1036 file dir))
1037 beg (save-excursion (skip-chars-backward "^/" lim) (point)))))
1038 (cond
1039 ((stringp cmpl)
1040 (if (string= initial cmpl)
1041 (with-output-to-temp-buffer "*Completions*"
1042 (princ "Possible completinos are:\n")
1043 (princ
1044 (mapconcat (function(lambda (x) x)) (funcall listfunc) "\n")))
1045 (delete-region (point) beg)
1046 (insert cmpl)))
1047 ((null cmpl)
1048 (ding))
1049 ((eq t cmpl)
1050 (save-excursion
1051 (unwind-protect
1052 (progn
1053 (goto-char p)
1054 (insert " [Sole completion]"))
1055 (delete-region p (point-max))))))))
1058 ; Subject: [yatex:02849] Re: [yahtml] tilda in href tag
1059 ; From: Masayasu Ishikawa <mimasa<at>sfc.keio.ac.jp>
1060 ; To: yatex<at>arcadia.jaist.ac.jp
1061 ; Date: Mon, 31 May 1999 21:09:31 +0900
1062 ; RFC 2396 の "2.4.3. Excluded US-ASCII Characters" によると、以下の文字
1063 ; は必ずエスケープしないといけません。
1065 ; control = <US-ASCII coded characters 00-1F and 7F hexadecimal>
1066 ; space = <US-ASCII coded character 20 hexadecimal>
1067 ; delims = "<" | ">" | "#" | "%" | <">
1068 ; unwise = "{" | "}" | "|" | "\" | "^" | "[" | "]" | "`"
1069 (defvar yahtml-unsafe-chars-regexp
1070 "[][\x0- \x7f <>%\"{}|\\^`]" ;#は除去する
1071 "Characters regexp which must be escaped in URI.")
1073 ; また、以下の文字は予約された用法以外に用いる場合にはエスケープしないと
1074 ; いけないことになっています。
1076 ; reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" |
1077 ; "$" | ","
1078 (defvar yahtml-unreserved-chars-regexp
1079 "[;/?:@&=+$,]"
1080 "Characters regexp which should be escaped in URI on certain conditions.
1081 Not used yet.")
1083 (defun yahtml-escape-chars-string (str)
1084 "Translate reserved chars to URL encoded string."
1085 (let ((p 0) (target "")
1086 (ask (eq yahtml-escape-chars 'ask)))
1087 (cond
1088 ((null yahtml-escape-chars) str)
1089 ((string-match "%[0-9A-F][0-9A-F]%[0-9A-F][0-9A-F]%[0-9A-F][0-9A-F]" str)
1090 str)
1091 (t
1092 (while (and (string< "" str)
1093 (setq p (string-match yahtml-unsafe-chars-regexp str)))
1094 (if (and ask (y-or-n-p (format "Escape char [%c] of `%s'"
1095 (aref str p) (substring str 0 (1+ p)))))
1096 (setq target (concat target
1097 (substring str 0 p)
1098 (format "%%%x" (aref str p))))
1099 (setq target (concat target (substring str 0 (1+ p)))))
1100 (setq str (substring str (1+ p))))
1101 (concat target str)))))
1103 (defun yahtml-unescape-string (str)
1104 "Untranslate reserved URL-encoded string."
1105 (let ((p 0) c (target "") (md (match-data)) (case-fold-search nil))
1106 (unwind-protect
1107 (progn
1108 (while (string-match "%\\([0-9a-f][0-9a-f]\\)" str p)
1109 (setq target (concat target
1110 (substring str p (1- (match-beginning 1))))
1111 p (match-end 0)
1112 c (YaTeX-hex (substring
1113 str (match-beginning 1) (match-end 1)))
1114 target (concat target (format "%c" c))))
1115 (concat target (substring str p)))
1116 (store-match-data md))))
1118 (defun yahtml-escape-chars-region (beg end)
1119 "Translate reserved chars to encoded string in the region."
1120 (interactive "r")
1121 (save-excursion
1122 (let ((e (set-marker (make-marker) end)) c m yes)
1123 (goto-char beg)
1124 (while (and (< (point) e)
1125 (re-search-forward
1126 (concat yahtml-unsafe-chars-regexp "\\|"
1127 yahtml-unreserved-chars-regexp) e t))
1128 (sit-for 0)
1129 ; (setq m (buffer-modified-p)
1130 ; c (char-after (1- (point))))
1131 ; (save-excursion (backward-char 1) (insert " ==>"))
1132 ; (unwind-protect
1133 ; (setq yes (y-or-n-p (format "Replace: [%c]" c)))
1134 ; (save-excursion
1135 ; (backward-char 1)
1136 ; (delete-backward-char 4))
1137 ; (set-buffer-modified-p m))
1138 (message "Replace: [%c] (y or n):" (setq c (char-after (1- (point)))))
1139 (if (memq (read-char) '(?y ?Y))
1140 (progn
1141 (delete-region (match-beginning 0) (match-end 0))
1142 (insert (format "%%%x" c)))))
1143 (set-marker e nil))))
1144 ;; ab%defgls/.|
1146 (defun yahtml-read-url (prompt)
1147 (let ((href ""))
1148 (setq yahtml-completing-buffer (current-buffer)
1149 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
1150 href (yahtml-escape-chars-string
1151 (read-from-minibuffer-with-history
1152 prompt "" yahtml-url-completion-map)))
1153 (prog1
1154 href
1155 (if (and (string-match "^https?://" href)
1156 (null (assoc href yahtml-urls-private))
1157 (null (assoc href yahtml-urls-local)))
1158 (YaTeX-update-table
1159 (list href)
1160 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))
1162 (defun yahtml:a ()
1163 "Add-in function for <a>"
1164 (let ((href (yahtml-read-url "href: ")))
1165 (concat (yahtml-make-optional-argument
1166 "href" href)
1167 (yahtml-make-optional-argument
1168 "name" (read-string-with-history "name: ")))))
1170 (defvar yahtml-parameters-completion-alist
1171 '(("align" ("top") ("middle") ("bottom") ("left") ("right") ("center"))
1172 ("clear" ("left") ("right") ("center") ("all") ("none"))
1173 ("lang" ("ja") ("en") ("kr") ("ch") ("fr"))
1174 ("src" . file) ("file" . file) ("poster" . file)
1175 ("background" . file)
1176 ("class file name" . file) ("data" . file)
1177 ("method" ("POST") ("GET"))
1178 ("rev" . yahtml-link-types-alist)
1179 ("rel" . yahtml-link-types-alist)
1180 ("type" . yahtml-content-types-alist)
1181 ("codetype" . yahtml-content-types-alist)
1182 ("http-equiv" ("Refresh") ("Content-Language") ("Content-Type"))
1183 ("charset"
1184 ("utf-8")("euc-jp")("iso-2022-jp")("iso-8859-1")("shift_jis"))))
1186 (defvar yahtml-link-types-alist
1187 '(("alternate") ("stylesheet") ("start") ("next") ("prev")
1188 ("contents") ("index") ("glossary") ("chapter") ("section")
1189 ("subsection") ("appendix") ("help") ("bookmark") ("manifest")))
1191 (defvar yahtml-content-types-alist
1192 '(("text/css") ("text/html") ("text/plain") ("text/richtext")
1193 ("text/sgml") ("text/xml")
1194 ("text/javascript") ("text/tcl") ("text/vbscript")
1195 ("application/octet-stream") ("application/postscript") ("application/pdf")
1196 ("application/java")
1197 ("image/jpeg") ("image/gif") ("image/tiff") ("image/png") ("video/mpeg"))
1198 "Alist of content-types")
1200 (defun yahtml-read-parameter (par &optional default alist predicate)
1201 (let* ((alist
1202 (cdr-safe (assoc (downcase par)
1203 (or alist yahtml-parameters-completion-alist))))
1204 (prompt (concat par ": "))
1205 v)
1206 (cond
1207 ((eq alist 'file)
1208 (let ((insert-default-directory))
1209 (read-file-name prompt "" default nil "" predicate)))
1210 ((eq alist 'command)
1211 (if (fboundp 'read-shell-command)
1212 (read-shell-command prompt)
1213 (read-string-with-history prompt)))
1214 ((and alist (symbolp alist))
1215 (completing-read-with-history
1216 prompt (symbol-value alist) nil nil default))
1217 (alist
1218 (completing-read-with-history prompt alist nil nil default))
1219 (t
1220 (read-string-with-history prompt default)))))
1222 (defun yahtml-read-file-name-regexp
1223 (prompt regexp &optional dir default-filename mustmatch initial)
1224 (let ((pred
1225 (function
1226 (lambda (f)
1227 (or (file-name-directory f)
1228 (string-match regexp f)))))
1229 (insert-default-directory nil))
1230 (read-file-name prompt dir default-filename mustmatch initial pred)))
1233 (defun yahtml-make-optional-argument (opt arg)
1234 "Make optional argument string."
1235 (if (or (null arg) (string= "" arg))
1236 ""
1237 (concat " "
1238 (if yahtml-prefer-upcase-attributes (upcase opt) (downcase opt))
1239 "=\"" arg "\"")))
1241 (defun yahtml:html ()
1242 "Add-in for <html>"
1243 (setq yahtml-last-begend "head" yahtml-last-typeface-cmd "head")
1244 (yahtml-make-optional-argument
1245 "lang" (yahtml-read-parameter "lang" (if YaTeX-japan "ja"))))
1247 (defun yahtml:head ()
1248 "Add-in for <head>"
1249 (setq yahtml-last-begend "title" yahtml-last-typeface-cmd "title")
1250 "")
1252 (defun yahtml:body ()
1253 "Add-in function for <body>"
1254 (cond
1255 (yahtml-html4-strict nil)
1256 (t
1257 (let ((b (read-string-with-history "bgcolor="))
1258 (bg (yahtml-read-parameter "background" ""))
1259 (x (read-string-with-history "text color="))
1260 (l (read-string-with-history "link color="))
1261 (v (read-string-with-history "vlink color=")))
1262 (concat
1263 (yahtml-make-optional-argument "bgcolor" b)
1264 (yahtml-make-optional-argument "background" bg)
1265 (yahtml-make-optional-argument "text" x)
1266 (yahtml-make-optional-argument "link" l)
1267 (yahtml-make-optional-argument "vlink" v))))))
1269 (defun yahtml-make-style-parameter (proplist)
1270 "Make CSS property definitions in style attribute."
1271 (mapconcat
1272 (function (lambda (x) (if (and (cdr x) (string< "" (cdr x)))
1273 (format "%s: %s;" (car x) (cdr x)))))
1274 (delq nil proplist)
1275 " "))
1277 (defun yahtml:img ()
1278 "Add-in function for <img>"
1279 (let ((src (yahtml-read-parameter "src"))
1280 (alg (if yahtml-html4-strict nil (yahtml-read-parameter "align")))
1281 alt
1282 (brd (read-string-with-history "border="))
1283 (l yahtml-prefer-upcase-attributes)
1284 info width height bytes comments)
1285 (and (stringp src) (string< "" src) (file-exists-p src)
1286 (setq info (yahtml-get-image-info src))
1287 (car info)
1288 (setq width (int-to-string (car info))
1289 height (int-to-string (car (cdr info)))
1290 bytes (car (cdr (cdr info)))
1291 comments (nth 4 info)))
1292 (if info
1293 (setq alt
1294 (YaTeX-replace-formats
1295 yahtml:img-default-alt-format
1296 (list (cons "x" width)
1297 (cons "y" height)
1298 (cons "s" (int-to-string bytes))
1299 (cons "f" (file-name-nondirectory src))
1300 (cons "c" (car comments))))))
1302 (setq alt (yahtml-read-parameter "alt" alt))
1303 (setq width (yahtml-read-parameter "width" width)
1304 height (yahtml-read-parameter "height" height))
1305 (concat (if l "SRC" "src") "=\"" src "\""
1306 (yahtml-make-optional-argument "alt" alt)
1307 (yahtml-make-optional-argument "width" width)
1308 (yahtml-make-optional-argument "height" height)
1309 (if yahtml-html4-strict
1310 (yahtml-make-optional-argument
1311 "style"
1312 (if (or brd alg)
1313 (yahtml-make-style-parameter
1314 (list
1315 (if (string< "" alg)
1316 (cons "align" alg))
1317 (if (string< "" brd)
1318 (cons "border"
1319 (format "%dpx" (YaTeX-str2int brd))))))))
1320 (concat
1321 (yahtml-make-optional-argument "border" brd)
1322 (yahtml-make-optional-argument "align" alg))))))
1324 (defun yahtml-file-truename (file)
1325 (cond
1326 ((fboundp 'file-truename) (file-truename (expand-file-name file)))
1327 (t (let ((new file))
1328 (while (and (stringp (setq new (nth 0 (file-attributes file))))
1329 (not (equal new file)))
1330 (setq file new))
1331 file))))
1333 (defun yahtml-hex-value (point length &optional little-endian)
1334 "Return the hex value the POINT positions LENGTH byte stream represents.
1335 Optional third argument LITTLE-ENDIAN is self extplanatory."
1336 (setq point (1+ point)) ;translate file offset to Emacs's point value
1337 (let ((mlt 1)
1338 (pos (if little-endian point (+ point length -1)))
1339 (direc (if little-endian 1 -1))
1340 (value 0))
1341 (while (> length 0)
1342 (setq value (+ value (* mlt (char-after pos)))
1343 pos (+ pos direc)
1344 mlt (* mlt 256)
1345 length (1- length)))
1346 value))
1348 (defun yahtml-get-image-info (file)
1349 "Return the information on the image file FILE.
1350 Returns list of '(WIDTH HEIGHT BYTES DEPTH COMMENTLIST)."
1351 (save-excursion
1352 (let*((tmpbuf (get-buffer-create " *imgheader*"))
1353 width height bytes depth comment
1354 (file-coding-system-alist (list (cons "." 'no-conversion))) ;20
1355 (file-coding-system-for-read (and (boundp '*noconv*) *noconv*)) ;19
1356 (coding-system-for-read 'no-conversion)
1357 (seekpoint 1)
1358 c1 c2 c3 c4 beg end
1359 (case-fold-search nil))
1360 (setq bytes (nth 7 (file-attributes (yahtml-file-truename file))))
1361 (set-buffer tmpbuf)
1362 (if (boundp 'mc-flag) (set (make-local-variable 'mc-flag) nil))
1363 (erase-buffer)
1364 (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))
1365 (unwind-protect
1366 (progn
1367 (message "Inspecting image information of %s..." file)
1368 ;; Read 4bytes-more than inspection-bytes in case that
1369 ;; JPEG marker delimiter (4bytes) is on the alignment.
1370 (YaTeX-insert-file-contents
1371 file nil 0 (+ yahtml-image-inspection-bytes 4))
1372 (goto-char (point-min)) ;assertion
1373 (setq c1 (char-after 1) ;cache first 4 bytes
1374 c2 (char-after 2)
1375 c3 (char-after 3)
1376 c4 (char-after 4))
1377 (cond
1378 ((and (eq c1 ?\377) (eq c2 ?\330)) ; 0xff 0xd8
1379 ;;JPEG images need JPEG markers inspection
1380 ;;JPEG markers consist of [ 0xff ID(B) LEN(S) CONTENTS... ]
1381 ;; Warning: here seekpoint is measured by Emacs's point value
1382 ;; while yahtml-hex-vale requires file offset
1383 (setq seekpoint 3) ;where the first JPEG marker exists
1384 (catch 'exit
1385 (while (< seekpoint (- (buffer-size) 4))
1386 (cond
1387 ((not (eq (char-after seekpoint) ?\377))
1388 ;maybe corrupted, exit from loop
1389 (throw 'exit t))
1390 ((memq
1391 (char-after (1+ seekpoint))
1392 '(?\300 ?\301 ?\302 ?\303
1393 ?\305 ?\306 ?\307 ?\311 ?\312 ?\313 ?\315 ?\316 ?\317))
1394 ;;'(192 193 194 195 197 198 199 201 202 203 205 206 207
1395 ;;found!
1396 (setq height (yahtml-hex-value (+ seekpoint 4) 2)
1397 width (yahtml-hex-value (+ seekpoint 6) 2)
1398 depth (yahtml-hex-value (+ seekpoint 3) 1)))
1399 ((eq (char-after (1+ seekpoint)) ?\376) ;0xFE = comment
1400 ;; JPEG comment area
1401 (setq beg (+ seekpoint 2 2)
1402 end (+ seekpoint
1403 (yahtml-hex-value (1+ seekpoint) 2) 2))
1404 (setq comment (cons (buffer-substring beg end) comment)))
1405 (t ;other markers
1406 nil)) ;just skip it
1407 (setq seekpoint (+ seekpoint 2)
1408 seekpoint (+ seekpoint
1409 (yahtml-hex-value (1- seekpoint) 2))))))
1410 ((and (eq c1 ?\211) ;0x89
1411 (eq c2 ?P) (eq c3 ?N) (eq c4 ?G))
1412 ;;PNG Image data X=@0x10(L), Y=@0x14(L), D=@0x18(B)
1413 (setq width (yahtml-hex-value 16 4)
1414 height (yahtml-hex-value 20 4)
1415 depth (yahtml-hex-value 24 1)))
1416 ((looking-at "GIF8")
1417 ;;GIF Image data X=@0x6(leshort), Y=@0x8(leshort)
1418 (setq width (yahtml-hex-value 6 2 t)
1419 height (yahtml-hex-value 8 2 t)))
1420 ((looking-at "BM")
1421 ;;# OS/2, Windoze BMP files
1422 ;;@0x0e = 12 -> OS/2 1.x - X=@0x12(leshort), Y=@0x14(leshort)
1423 ;;@0x0e = 64 -> OS/2 2.x - X=@0x12(leshort), Y=@0x14(leshort)
1424 ;;@0x0e = 40 -> Windows 3.x - X=@0x12(lelong), Y=@0x16(lelong)
1425 (cond
1426 ((eq (yahtml-hex-value 14 2 t) 40)
1427 (setq width (yahtml-hex-value 18 4 t)
1428 height (yahtml-hex-value 22 4 t)))
1429 (t
1430 (setq width (yahtml-hex-value 18 2 t)
1431 height (yahtml-hex-value 20 2 t)))))))
1432 (message "")
1433 (kill-buffer tmpbuf))
1434 (list width height bytes depth (nreverse comment)))))
1436 (defun yahtml:form ()
1437 "Add-in function `form' input format"
1438 (concat
1439 " " (if yahtml-prefer-upcase-attributes "METHOD" "method") "=\""
1440 (completing-read-with-history "Method: " '(("POST") ("GET")) nil t)
1441 "\""
1442 (yahtml-make-optional-argument
1443 (if yahtml-prefer-upcase-attributes "ENCTYPE" "enctype")
1444 (completing-read-with-history
1445 "Enctype: "
1446 '(("application/x-www-form-urlencoded") ("multipart/form-data"))))
1447 " " (if yahtml-prefer-upcase-attributes "ACTION" "action") "=\""
1448 (read-string-with-history "Action: ") "\""))
1450 (defun yahtml:select ()
1451 "Add-in function for `select' input format"
1452 (setq yahtml-last-single-cmd "option" ;;<- it's old
1453 yahtml-last-typeface-cmd "option")
1454 (concat " " (if yahtml-prefer-upcase-attributes "NAME" "name") "=\""
1455 (read-string-with-history "name: ") "\""))
1456 (defun yahtml:label ()
1457 "Add-in function for `<label>'"
1458 (yahtml-make-optional-argument
1459 "for"
1460 (YaTeX-completing-read-or-skip "for=" (yahtml-collect-ids) nil t)))
1462 (defun yahtml:ol ()
1463 "Add-in function for <ol>"
1464 (setq yahtml-last-typeface-cmd "li")
1465 (let ((start (YaTeX-read-string-or-skip "start="))
1466 (type (YaTeX-completing-read-or-skip
1467 "type=" '(("1") ("a") ("A") ("i") ("I")) nil t)))
1468 (concat
1469 (yahtml-make-optional-argument "start" start)
1470 (yahtml-make-optional-argument "type" type))))
1471 (defun yahtml:ul ()
1472 (setq yahtml-last-typeface-cmd "li") "")
1473 (defun yahtml:dl ()
1474 (setq yahtml-last-typeface-cmd "dt") "")
1475 (defun yahtml:dt ()
1476 (setq yahtml-last-typeface-cmd "dd") "")
1478 (defun yahtml:p ()
1479 (if yahtml-html4-strict nil
1480 (let ((alg (yahtml-read-parameter "align")))
1481 (yahtml-make-optional-argument "align" alg))))
1483 (defvar yahtml-input-types
1484 '(("text") ("password") ("checkbox") ("radio") ("submit")
1485 ("reset") ("image") ("hidden") ("file")
1486 ("date") ("time") ("datetime-local") ("week") ("number") ("tel")
1487 ("range") ("color")))
1489 (defun yahtml:input ()
1490 "Add-in function for `input' form"
1491 (let ((size "") name type value id (maxlength "")
1492 (l yahtml-prefer-upcase-attributes))
1493 (setq name (read-string-with-history "name: ")
1494 type (YaTeX-completing-read-or-skip "type (default=text): "
1495 yahtml-input-types nil t)
1496 value (YaTeX-read-string-or-skip "value: "))
1497 (or (string-match "submit\\|reset" type)
1498 (setq id (YaTeX-read-string-or-skip "id: ")))
1499 (if (string-match "text\\|password\\|^$" type)
1500 (setq size (YaTeX-read-string-or-skip "size: ")
1501 maxlength (YaTeX-read-string-or-skip "maxlength: ")))
1502 (concat
1503 (if l "NAME" "name") "=\"" name "\""
1504 (yahtml-make-optional-argument "type" type)
1505 (yahtml-make-optional-argument "value" value)
1506 (yahtml-make-optional-argument "id" id)
1507 (yahtml-make-optional-argument "size" size)
1508 (if (string-match "range" type)
1509 (concat (yahtml-make-optional-argument
1510 "min" (YaTeX-read-string-or-skip "min: "))
1511 (yahtml-make-optional-argument
1512 "max" (YaTeX-read-string-or-skip "max: "))
1513 (yahtml-make-optional-argument
1514 "step" (YaTeX-read-string-or-skip "step: "))))
1515 (yahtml-make-optional-argument "maxlength" maxlength))))
1517 (defun yahtml:datalist ()
1518 "Add-in function for `datalist' form"
1519 (setq yahtml-last-typeface-cmd "option")
1520 (let ((ids (yahtml-collect-ids)))
1521 (yahtml-make-optional-argument
1522 "id" (YaTeX-completing-read-or-skip "id: " ids nil t))))
1524 (defun yahtml:textarea ()
1525 "Add-in function for `textarea'"
1526 (interactive)
1527 (let (name rows cols)
1528 (setq name (read-string-with-history "Name: ")
1529 cols (read-string-with-history "Columns: ")
1530 rows (read-string-with-history "Rows: "))
1531 (concat
1532 (concat (if yahtml-prefer-upcase-attributes "NAME=" "name=")
1533 "\"" name "\"")
1534 (yahtml-make-optional-argument "cols" cols)
1535 (yahtml-make-optional-argument "rows" rows))))
1537 (defun yahtml:table ()
1538 "Add-in function for `table'"
1539 (let ((b (read-string-with-history "border="))
1540 (a (if yahtml-html4-strict ""
1541 (yahtml-read-parameter
1542 "align" nil '(("align" ("right")("center")))))))
1543 (if yahtml-html4-strict
1544 (yahtml-make-optional-argument
1545 "style"
1546 (if (or (string< "" b) (string< "" a))
1547 (yahtml-make-style-parameter
1548 (append
1549 (if (string< "" b)
1550 (list
1551 (cons "border" (format "%dpx solid" (YaTeX-str2int b)))
1552 (cons "border-collapse" "collapse")))
1553 (if (string< "" a)
1554 (cond
1555 ((string-match "right" a)
1556 (list (cons "margin-left" "auto")
1557 (cons "margin-right" "0")))
1558 ((string-match "center" a)
1559 (list (cons "margin-left" "auto")
1560 (cons "margin-right" "auto")))))))))
1561 (concat
1562 (yahtml-make-optional-argument "border" b)
1563 (yahtml-make-optional-argument "align" a)))))
1565 ;(fset 'yahtml:caption 'yahtml:p)
1566 (defun yahtml:caption ()
1567 "Add-in function for `caption' in table tag"
1568 (let ((par (yahtml-read-parameter "align")))
1569 (if yahtml-html4-strict
1570 (yahtml-make-optional-argument
1571 "style" (if par (yahtml-make-style-parameter
1572 (list (cons "caption-side" par)))))
1573 (yahtml-make-optional-argument "align" par))))
1575 (defun yahtml:font ()
1576 "Add-in function for `font'"
1577 (concat
1578 (yahtml-make-optional-argument "color" (read-string-with-history "color="))
1579 (yahtml-make-optional-argument "size" (read-string-with-history "size="))))
1581 (defun yahtml:style ()
1582 "Add-in function for `style'"
1583 (yahtml-make-optional-argument
1584 "type" (read-string-with-history "type=" "text/css")))
1586 (defun yahtml:script ()
1587 "Add-in function for `script'"
1588 (concat
1589 (yahtml-make-optional-argument
1590 "type" (yahtml-read-parameter "type" "text/javascript"))
1591 (yahtml-make-optional-argument
1592 "src" (yahtml-read-parameter "src" ""))))
1594 (defun yahtml:tr ()
1595 "Add-in function for `tr'"
1596 (setq yahtml-last-typeface-cmd "td")
1597 "")
1599 (defun yahtml:link ()
1600 "Add-in function for `link' (まだちょっと良く分かってない)"
1601 (let (rel rev type href)
1602 (setq rel (yahtml-read-parameter "rel"))
1603 (cond
1604 ((equal rel "")
1605 (concat (yahtml-make-optional-argument
1606 "rev" (yahtml-read-parameter "rev"))
1607 (yahtml-make-optional-argument
1608 "href" (yahtml-read-parameter "href")
1609 ;;他に良く使うのって何?
1610 )))
1611 ((string-match "stylesheet" rel)
1612 (concat
1613 (yahtml-make-optional-argument "rel" rel)
1614 (yahtml-make-optional-argument
1615 "type" (yahtml-read-parameter "type" "text/css"))
1616 (progn
1617 (setq href
1618 (read-from-minibuffer-with-history
1619 "href: " "" yahtml-url-completion-map))
1620 (if (string< "" href)
1621 (progn
1622 (if (and (file-exists-p (yahtml-url-to-path href))
1623 (y-or-n-p "Load css symbols now? "))
1624 (setq yahtml-css-class-alist
1625 (yahtml-css-collect-classes-file
1626 (yahtml-url-to-path href) yahtml-css-class-alist)))
1627 (message "")
1628 (yahtml-make-optional-argument "href" href))))))
1629 (t
1630 (concat
1631 (yahtml-make-optional-argument "rel" rel)
1632 (yahtml-make-optional-argument
1633 "type" (yahtml-read-parameter "type"))
1634 (yahtml-make-optional-argument
1635 "href"
1636 (read-from-minibuffer-with-history
1637 "href: " "" yahtml-url-completion-map)))))))
1639 (defvar yahtml:meta-attrs
1640 '(("charset" value)
1641 ("name" content ("keywords")("author")("copyright")("date")("GENERATOR")
1642 ("viewport"))
1643 ("http-equiv" content)))
1645 (defun yahtml:meta ()
1646 (let ((attr (completing-read-with-history
1647 "Meta Attribute: " yahtml:meta-attrs))
1648 (case-fold-search t)
1649 (completion-ignore-case t)
1650 todonext name http-equiv content)
1651 (cond
1652 ((string= "" attr) nil)
1653 ((and (setq todonext (cdr-safe (assoc attr yahtml:meta-attrs)))
1654 (eq 'value (car todonext)))
1655 (yahtml-make-optional-argument attr (yahtml-read-parameter attr)))
1656 ((eq 'content (car todonext))
1657 (setq name (if (cdr todonext)
1658 (completing-read-with-history
1659 (format "%s: " attr) (cdr todonext))
1660 (yahtml-read-parameter attr)))
1661 (concat
1662 (yahtml-make-optional-argument attr name)
1663 (yahtml-make-optional-argument
1664 "content"
1665 (cond
1666 ((string-match "date" name)
1667 (read-string-with-history "Date: " (current-time-string)))
1668 ((string-match "author" name)
1669 (read-string-with-history "Author: "
1670 (if (and (user-full-name) (string< "" (user-full-name)))
1671 (user-full-name)
1672 (user-login-name))))
1673 ((string-match "GENERATOR" name)
1674 (setq content (read-string-with-history
1675 "Generator: " "User-agent: "))
1676 (if (string-match "yahtml" content)
1677 (message "Thank you!"))
1678 content)
1679 ((string-match "content-type" name)
1680 (if (string-match "http-equiv" attr )
1681 (error "Use <meta charset=\"...\" instead.. See docs/qanda.")
1682 (yahtml-make-optional-argument
1683 "content" (yahtml-read-parameter "content"))))
1684 ((string-match "viewport" name)
1685 ;; XXX: Very dirty static string
1686 "width=device-width, initial-scale=1")
1687 (t (read-string-with-history (concat name ": ")))))))
1688 (t (yahtml-make-optional-argument
1689 attr (yahtml-read-parameter attr))))))
1691 (defun yahtml:br ()
1692 (yahtml-make-optional-argument "clear" (yahtml-read-parameter "clear")))
1694 (defun yahtml:object ()
1695 (let ((codetype (yahtml-read-parameter "codetype" "application/java"))
1696 data classid)
1697 (cond
1698 ((string-match "java" codetype)
1699 (let ((completion-ignored-extensions
1700 ;;any extensions except ".class"
1701 '(".java" ".html" ".htm" ".gif" ".jpg" ".jpeg" ".png")))
1702 (setq classid (concat "java:"
1703 (yahtml-read-parameter "class file name"))))
1704 (concat
1705 (yahtml-make-optional-argument "codetype" codetype)
1706 (yahtml-make-optional-argument "classid" classid)
1707 (yahtml-make-optional-argument
1708 "width" (yahtml-read-parameter "width"))
1709 (yahtml-make-optional-argument
1710 "height" (yahtml-read-parameter "height"))))
1711 (t
1712 ""))))
1714 (defun yahtml:abbr ()
1715 "Add-in function for abbr."
1716 (yahtml-make-optional-argument "title" (yahtml-read-parameter "title")))
1718 (defun yahtml:button ()
1719 (concat
1720 (yahtml-make-optional-argument
1721 "name" (yahtml-read-parameter "name"))
1722 (yahtml-make-optional-argument
1723 "type" (yahtml-read-parameter
1724 "type" "button" '(("submit")("reset")("button"))))
1725 (yahtml-make-optional-argument
1726 "value" (yahtml-read-parameter "value"))))
1728 (defun yahtml::article ()
1729 (setq yahtml-last-typeface-cmd "h1" yahtml-last-begend "h1"))
1731 (defun yahtml:meter ()
1732 (concat
1733 (yahtml-make-optional-argument
1734 "min" (yahtml-read-parameter "min"))
1735 (yahtml-make-optional-argument
1736 "max" (yahtml-read-parameter "max"))
1737 (yahtml-make-optional-argument
1738 "low" (yahtml-read-parameter "low"))
1739 (yahtml-make-optional-argument
1740 "high" (yahtml-read-parameter "high"))
1741 (yahtml-make-optional-argument
1742 "value" (yahtml-read-parameter "value"))))
1744 (defun yahtml:progress ()
1745 (concat
1746 (yahtml-make-optional-argument
1747 "max" (yahtml-read-parameter "max"))
1748 (yahtml-make-optional-argument
1749 "value" (yahtml-read-parameter "value"))))
1751 ;;; ---------- Simple tag ----------
1752 (defun yahtml-insert-tag (region-mode &optional tag)
1753 "Insert <TAG> </TAG> and put cursor inside of them."
1754 (interactive "P")
1755 (setq yahtml-current-completion-type 'inline
1756 region-mode (or region-mode (YaTeX-region-active-p)))
1757 (or tag
1758 (let ((completion-ignore-case t))
1759 (setq tag
1760 (YaTeX-cplread-with-learning
1761 (format "Tag %s(default %s): "
1762 (if region-mode "region: " "") yahtml-last-typeface-cmd)
1763 'yahtml-typeface-table 'yahtml-user-typeface-table
1764 'yahtml-tmp-typeface-table))))
1765 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))
1766 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))
1767 (setq yahtml-last-typeface-cmd tag
1768 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))
1769 (if region-mode
1770 (if (if (string< "19" emacs-version) (mark t) (mark))
1771 (save-excursion
1772 (if (> (point) (mark)) (exchange-point-and-mark))
1773 (insert (format "<%s%s>" tag (yahtml-addin tag)))
1774 (exchange-point-and-mark)
1775 (insert "</" tag ">"))
1776 (message "No mark set now"))
1777 (insert (format "<%s%s>" tag (yahtml-addin tag)))
1778 (save-excursion (insert (format "</%s>" tag)))))
1780 (defun yahtml-insert-tag-region (&optional tag)
1781 "Call yahtml-insert-tag with region mode."
1782 (interactive)
1783 (yahtml-insert-tag t tag))
1785 (defvar yahtml-need-single-closer nil) ;for test
1786 (defun yahtml-insert-single (cmd)
1787 "Insert <CMD>."
1788 (interactive
1789 (list
1790 (let ((completion-ignore-case t))
1791 (YaTeX-cplread-with-learning
1792 (format "Command%s: "
1793 (if yahtml-last-single-cmd
1794 (concat "(default " yahtml-last-single-cmd ")") ""))
1795 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table
1796 'yahtml-tmp-single-cmd-table))))
1797 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))
1798 (setq yahtml-last-single-cmd
1799 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))
1800 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
1801 yahtml-last-single-cmd))
1802 (insert (format "<%s%s%s>"
1803 cmd
1804 (yahtml-addin cmd)
1805 (if (and yahtml-need-single-closer
1806 (assoc cmd '(("br")("hr"))))
1807 " /" "")))
1808 (if (assoc cmd yahtml-env-table)
1809 (save-excursion (insert (format "</%s>" cmd)))))
1811 (defun yahtml-insert-p (&optional arg)
1812 "Convenient function to insert <p></p>"
1813 (interactive "P")
1814 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")
1815 (yahtml-insert-single "p")))
1817 (defun yahtml-insert-amps (arg)
1818 "Insert char-entity references via ampersand"
1819 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/
1820 (interactive "P")
1821 (let*((mess "") c
1822 (list (append yahtml-entity-reference-chars-alist-default
1823 yahtml-entity-reference-chars-alist))
1824 (l list))
1825 (while l
1826 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))
1827 l (cdr l)))
1828 (message "Char-entity reference: %s SPC=& RET=&; BS=%s Other=&#..;"
1829 mess (if YaTeX-japan "直前の文字" "Preceding-Char"))
1830 (setq c (read-char))
1831 (cond
1832 ((equal c (car-safe (assoc c list)))
1833 (insert (format "&%s;" (cdr (assoc c list)))))
1834 ((or (equal c ?\n) (equal c ?\r))
1835 (insert "&;")
1836 (forward-char -1))
1837 ((equal c ? )
1838 (insert ?&))
1839 ((and (memq c '(127 8))
1840 (setq c (preceding-char))
1841 (delete-backward-char 1)
1842 nil)) ;Fall through to the next 't block
1843 (t (insert (format "&#x%x;" c))))))
1845 (defun yahtml:!--\#include ()
1846 (let ((file (yahtml-read-parameter "file" "")))
1847 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))
1849 (defun yahtml:!--\#exec ()
1850 (format "cmd=\"%s\"--"
1851 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))
1853 (defun yahtml:media-read-options (&optional opts-alist)
1854 (let*((delim " ")
1855 (minibuffer-completion-table
1856 (or opts-alist '(("autoplay") ("controls") ("loop") ("preload"))))
1857 (quotekey (substitute-command-keys "\\[quoted-insert]")))
1858 (read-from-minibuffer-with-history
1859 (format "Media Opts(`%s SPC' for more options): " quotekey)
1860 "controls" YaTeX-minibuffer-completion-map)))
1862 (defun yahtml:audio ()
1863 ;preload autoplay loop controls: `src' be specified via `source'
1864 (yahtml:media-read-options))
1866 (defun yahtml:video ()
1867 ;`src' be specified via `source'
1868 (let ((poster (yahtml-make-optional-argument
1869 "poster"
1870 (yahtml-read-file-name-regexp
1871 "Poster: " "\\.\\(gif\\|png\\|jpg\\|w?bmp\\|pict\\|tif\\)"
1872 "")))
1873 (opts (yahtml:media-read-options)))
1874 (concat poster (if (string< "" opts) (concat " " opts)))))
1876 (defvar yahtml-media-file-regexp
1877 "\\.\\(mp[0-9]\\|wav\\|og[gv]\\|opus\\|aac\\)"
1878 "*Default filename regexp of media files.")
1880 (defun yahtml:source ()
1881 ;; source element must have src attribute
1882 (format "src=\"%s\"" (yahtml-read-file-name-regexp
1883 "source: " yahtml-media-file-regexp "" "" nil "")))
1885 (defun yahtml:figure ()
1886 (setq yahtml-last-typeface-cmd "figcaption"))
1888 (defun yahtml:iframe ()
1889 (let ((src (yahtml-read-url "src: ")))
1890 (concat
1891 (yahtml-make-optional-argument "src" src)
1892 (yahtml-make-optional-argument
1893 "width" (YaTeX-read-string-or-skip "width: "))
1894 (yahtml-make-optional-argument
1895 "height" (YaTeX-read-string-or-skip "height: ")))))
1897 ;;; ---------- Jump ----------
1898 (defun yahtml-on-href-p ()
1899 "Check if point is on href clause."
1900 (let ((p (point)) e cmd (case-fold-search t))
1901 (save-excursion
1902 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした
1903 (save-excursion
1904 ;;(search-forward "</a>" nil t) ;aでなくても許可にした
1905 (search-forward "[\" \t\n]" nil t)
1906 (setq e (point)))
1907 ;(goto-char (get 'YaTeX-inner-environment 'point))
1908 (re-search-backward "<\\(a\\|link\\)\\>" nil t)
1909 (search-forward "href" e t)
1910 (search-forward "=" e t)
1911 (progn
1912 (skip-chars-forward " \t\n")
1913 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
1914 (< p (match-end 0))
1915 (yahtml-unescape-string (YaTeX-match-string 1))))))
1917 (defun yahtml-netscape-sentinel (proc mes)
1918 (cond
1919 ((null (buffer-name (process-buffer proc)))
1920 (set-process-buffer proc nil))
1921 ((eq (process-status proc) 'exit)
1922 (let ((cb (current-buffer)))
1923 (set-buffer (process-buffer proc))
1924 (goto-char (point-min))
1925 (if (search-forward "not running" nil t)
1926 (progn
1927 (message "Starting netscape...")
1928 (start-process
1929 "browser" (process-buffer proc)
1930 shell-file-name yahtml-shell-command-option
1931 (format "%s \"%s\"" yahtml-www-browser
1932 (get 'yahtml-netscape-sentinel 'url)))
1933 (message "Starting netscape...Done")))
1934 (set-buffer cb)))))
1936 (defvar yahtml-browser-process nil)
1938 (defun yahtml-browse-html (href)
1939 "Call WWW Browser to see HREF."
1940 (let ((pb "* WWW Browser *") (cb (current-buffer)))
1941 (cond
1942 ((string-match "^start\\>" yahtml-www-browser)
1943 (if (get-buffer pb)
1944 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1945 (put 'yahtml-netscape-sentinel 'url href)
1946 (set-process-sentinel
1947 (setq yahtml-browser-process
1948 (start-process
1949 "browser" pb shell-file-name yahtml-shell-command-option
1950 (format "%s \"%s\"" yahtml-www-browser href)))
1951 'yahtml-netscape-sentinel))
1952 ((and (string-match
1953 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)
1954 (not (eq system-type 'windows-nt)))
1955 (if (get-buffer pb)
1956 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1957 (put 'yahtml-netscape-sentinel 'url href)
1958 (set-process-sentinel
1959 (setq yahtml-browser-process
1960 (start-process
1961 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
1962 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))
1963 'yahtml-netscape-sentinel))
1964 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))
1965 (w3-fetch href))
1966 ((stringp yahtml-www-browser)
1967 (if (and yahtml-browser-process
1968 (eq (process-status yahtml-browser-process) 'run))
1969 (message "%s is already running" yahtml-www-browser)
1970 (setq yahtml-browser-process
1971 (start-process
1972 "browser" "* WWW Browser *"
1973 shell-file-name yahtml-shell-command-option
1974 (format "%s \"%s\"" yahtml-www-browser href)))))
1975 (t
1976 (message "Sorry, jump across http is not supported.")))))
1978 (defun yahtml-goto-corresponding-href (&optional other)
1979 "Go to corresponding name."
1980 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))
1981 (if href
1982 (cond
1983 ((string-match "^\\(ht\\|f\\)tps?:" href)
1984 (yahtml-browse-html href))
1985 (t (if (string-match "\&" href)
1986 (setq href (yahtml-untranslate-string href)))
1987 (setq file (substring href 0 (string-match "#" href)))
1988 (if (string-match "#" href)
1989 (setq name (substring href (1+ (string-match "#" href)))))
1990 (if (string< "" file)
1991 (progn
1992 (if (string-match "/$" file)
1993 (or (catch 'dirindex
1994 (mapcar
1995 (function
1996 (lambda (f)
1997 (if (file-exists-p (concat file f))
1998 (throw 'dirindex
1999 (setq file (concat file f))))))
2000 (yahtml-get-directory-index))
2001 nil)
2002 (setq file (concat file yahtml-directory-index))))
2003 (if (string-match "^/" file)
2004 (setq file (yahtml-url-to-path file)))
2005 (if other (YaTeX-switch-to-buffer-other-window file)
2006 (YaTeX-switch-to-buffer file))
2007 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))
2008 (if name
2009 (progn (set-mark-command nil) (yahtml-jump-to-name name)))
2010 t)))))
2012 (defun yahtml-jump-to-name (name)
2013 "Jump to html's named tag."
2014 (setq name (format "\\(name\\|id\\)\\s *=\\s *\"?%s\\>\"?" name))
2015 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))
2016 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))
2017 (message "Named tag `%s' not found" (substring href 1))))
2019 (defun yahtml-on-begend-p (&optional p)
2020 "Check if point is on begend clause."
2021 (let ((p (or p (point))) cmd (case-fold-search t))
2022 (save-excursion
2023 (goto-char p)
2024 (if (equal (char-after (point)) ?<) (forward-char 1))
2025 (if (and (re-search-backward "<" nil t)
2026 (looking-at
2027 ;(concat "<\\(/?" yahtml-struct-name-regexp "\\)\\b")
2028 "<\\(/?[A-Z][A-Z0-9]*\\)\\b")
2029 (condition-case nil
2030 (forward-list 1)
2031 (error nil))
2032 (< p (point)))
2033 (YaTeX-match-string 1)))))
2035 (defun yahtml-goto-corresponding-begend (&optional noerr)
2036 "Go to corresponding opening/closing tag.
2037 Optional argument NOERR causes no error for unballanced tag."
2038 (let ((cmd (yahtml-on-begend-p)) m0
2039 (p (point)) (case-fold-search t) func str (nest 0))
2040 (cond
2041 (cmd
2042 (setq m0 (match-beginning 0))
2043 (if (= (aref cmd 0) ?/) ;on </cmd> line
2044 (setq cmd (substring cmd 1)
2045 str (format "\\(<%s\\)\\|\\(</%s\\)" cmd cmd)
2046 func 're-search-backward)
2047 (setq str (format "\\(</%s\\)\\|\\(<%s\\)" cmd cmd)
2048 func 're-search-forward))
2049 (while (and (>= nest 0) (funcall func str nil t))
2050 (if (equal m0 (match-beginning 0))
2051 nil
2052 (setq nest (+ nest (if (match-beginning 1) -1 1)))))
2053 (if (< nest 0)
2054 (goto-char (match-beginning 0))
2055 (funcall
2056 (if noerr 'message 'error)
2057 "Corresponding tag of `%s' not found." cmd)
2058 (goto-char p)
2059 nil))
2060 (t nil))))
2062 (defun yahtml-current-tag ()
2063 "Return the current tag name including #exec and #include."
2064 (save-excursion
2065 (let ((p (point)) b tag)
2066 (or (bobp)
2067 (looking-at "<")
2068 (progn (skip-chars-backward "^<") (forward-char -1)))
2069 (setq b (point))
2070 (skip-chars-forward "<")
2071 (setq tag (YaTeX-buffer-substring
2072 (point) (progn (skip-chars-forward "^ \t\n") (point))))
2073 (goto-char b)
2074 (forward-list 1)
2075 (and (< p (point)) tag))))
2077 (defun yahtml-get-attrvalue (attr)
2078 "Extract current tag's attribute value from buffer."
2079 (let (e (case-fold-search t))
2080 (save-excursion
2081 (or (looking-at "<")
2082 (progn (skip-chars-backward "^<") (backward-char 1)))
2083 (setq e (save-excursion (forward-list 1) (point)))
2084 (if (and
2085 (re-search-forward (concat "\\b" attr "\\b") e t)
2086 (progn (skip-chars-forward " \t\n=")
2087 (looking-at "\"?\\([^\"> \t\n]+\\)\"?")))
2088 (YaTeX-match-string 1)))))
2090 (defun yahtml-goto-corresponding-img ()
2091 "View image on point"
2092 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))
2093 (if (and tag
2094 (string-match "img" tag)
2095 (setq image
2096 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))
2097 (progn
2098 (message "Invoking %s %s..." yahtml-image-viewer image)
2099 (start-process
2100 "Viewer" " * Image Viewer *"
2101 shell-file-name yahtml-shell-command-option ;"-c"
2102 (concat yahtml-image-viewer " " image))
2103 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))
2105 (defun yahtml-goto-corresponding-source (&optional other)
2106 "Goto applet's or script's source."
2107 (let ((env (yahtml-current-tag)) s (p (point)))
2108 (cond
2109 ((string-match "applet" env)
2110 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))
2111 (progn
2112 (setq s (YaTeX-match-string 1)
2113 s (concat
2114 (substring s 0 (string-match "\\.[A-Za-z]+$" s))
2115 ".java"))
2116 (if other (YaTeX-switch-to-buffer-other-window s)
2117 (YaTeX-switch-to-buffer s))
2118 s) ;return source file name
2119 (message "No applet source specified")
2120 (sit-for 1)
2121 nil))
2122 ((string-match "script" env)
2123 (if (setq s (yahtml-get-attrvalue "src"))
2124 (progn
2125 (funcall (if other 'YaTeX-switch-to-buffer-other-window
2126 'YaTeX-switch-to-buffer)
2127 (yahtml-url-to-path s))
2128 s)))
2129 ((string-match "!--#include" env)
2130 (cond
2131 ((setq s (yahtml-get-attrvalue "file")) ;<!--#include file="foo"-->
2132 (if other (YaTeX-switch-to-buffer-other-window s)
2133 (YaTeX-switch-to-buffer s))
2134 s)
2135 ((setq s (yahtml-get-attrvalue "virtual"));<!--#include virtual="foo"-->
2136 (setq s (yahtml-url-to-path s))
2137 (if other (YaTeX-switch-to-buffer-other-window s)
2138 (YaTeX-switch-to-buffer s))
2139 s)))
2140 ((and (string-match "!--#exec" env)
2141 (setq s (yahtml-get-attrvalue "cmd")))
2142 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0
2143 (let ((b " *yahtmltmp*")) ;peek a little
2144 (unwind-protect
2145 (progn
2146 (set-buffer (get-buffer-create b))
2147 (YaTeX-insert-file-contents s nil 0 100)
2148 (if (looking-at "#!")
2149 (if other (YaTeX-switch-to-buffer-other-window s)
2150 (YaTeX-switch-to-buffer s))))
2151 (kill-buffer (get-buffer b)))
2152 (get-file-buffer s))))))
2154 (defun yahtml-goto-corresponding-* (&optional other)
2155 "Go to corresponding object."
2156 (interactive "P")
2157 (cond
2158 ((yahtml-goto-corresponding-href other))
2159 ((yahtml-goto-corresponding-img))
2160 ((yahtml-goto-corresponding-source other))
2161 ((yahtml-goto-corresponding-begend))
2162 (t (message "I don't know where to go."))))
2164 (defun yahtml-goto-corresponding-*-other-window ()
2165 "Go to corresponding object."
2166 (interactive)
2167 (yahtml-goto-corresponding-* t))
2169 (defun yahtml-visit-main ()
2170 "Go to parent file from where you visit current file."
2171 (interactive)
2172 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))
2174 ;;; ---------- killing ----------
2175 (defun yahtml-kill-begend (&optional whole)
2176 (let ((tag (yahtml-on-begend-p)) p q r bbolp)
2177 (if tag
2178 (save-excursion
2179 (or (looking-at "<")
2180 (progn (skip-chars-backward "^<") (forward-char -1)))
2181 (setq p (point))
2182 (yahtml-goto-corresponding-begend)
2183 (or (looking-at "<")
2184 (progn (skip-chars-backward "^<") (forward-char -1)))
2185 (if (< (point) p) ;if on the opening tag
2186 (progn (setq q p p (point))
2187 (goto-char q))
2188 (setq q (point))) ;now q has end-line's (point)
2189 (if (not whole)
2190 (kill-region
2191 (progn (skip-chars-backward " \t")
2192 (if (setq bbolp (bolp)) (point) q))
2193 (progn (forward-list 1)
2194 (setq r (point))
2195 (skip-chars-forward " \t")
2196 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))
2197 (goto-char p)
2198 (skip-chars-backward " \t")
2199 (if (not whole)
2200 (progn
2201 (kill-append
2202 (buffer-substring
2203 (setq p (if (setq bbolp (bolp)) (point) p))
2204 (setq q (progn
2205 (forward-list 1)
2206 (setq r (point))
2207 (skip-chars-forward " \t")
2208 (if (and bbolp (eolp) (not (eobp)))
2209 (1+ (point))
2210 r))))
2211 t)
2212 (delete-region p q))
2213 (kill-region
2214 (if (bolp) (point) p)
2215 (progn (goto-char q)
2216 (forward-list 1)
2217 (setq r (point))
2218 (skip-chars-forward " \t")
2219 (if (and (eolp) (not (eobp))) (1+ (point)) r))))
2220 tag))))
2222 (defun yahtml-kill-* (whole)
2223 "Kill current position's HTML tag (set)."
2224 (interactive "P")
2225 (cond
2226 ((yahtml-kill-begend whole))))
2229 ;;; ---------- changing ----------
2230 (defun yahtml-on-assignment-p ()
2231 "Return if current point is on parameter assignment.
2232 If so, return parameter name, otherwise nil.
2233 This function should be able to treat white spaces in value, but not yet."
2234 (let ((p (point)))
2235 (save-excursion
2236 (put 'yahtml-on-assignment-p 'region nil)
2237 (skip-chars-backward "^ \t\n")
2238 (and (looking-at "\\([A-Za-z0-9]+\\)\\s *=\\s *\"?\\([^ \t\"]+\\)\"?")
2239 (< p (match-end 0))
2240 (>= p (1- (match-beginning 2)))
2241 (put 'yahtml-on-assignment-p 'region
2242 (cons (match-beginning 2) (match-end 2)))
2243 (YaTeX-match-string 1)))))
2245 (defun yahtml-change-begend ()
2246 (let ((tag (yahtml-on-begend-p))
2247 (completion-ignore-case t)
2248 (case-fold-search t)
2249 (p (point)) (q (make-marker))
2250 (default (append yahtml-env-table yahtml-typeface-table))
2251 (user (append yahtml-user-env-table yahtml-user-typeface-table))
2252 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))
2253 href b1 e1 attr new css)
2254 (cond
2255 (tag
2256 (cond
2257 ((and (string-match "^a$" tag)
2258 (save-excursion
2259 (and
2260 (re-search-backward "<a\\b" nil t)
2261 (progn
2262 (goto-char (match-end 0))
2263 (skip-chars-forward " \t\n")
2264 (setq b1 (point))
2265 (search-forward ">" nil t))
2266 (setq e1 (match-beginning 0))
2267 (goto-char b1)
2268 (re-search-forward "href\\s *=" e1 t)
2269 (>= p (point))
2270 (progn
2271 (goto-char (match-end 0))
2272 (skip-chars-forward " \t\n")
2273 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
2274 (< p (match-end 0)))))
2275 (setq b1 (match-beginning 1) e1 (match-end 1)
2276 yahtml-completing-buffer (current-buffer)
2277 ;; yahtml-urls-local is buffer-local, so we must put
2278 ;; that into yahtml-urls here
2279 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
2280 href (read-from-minibuffer
2281 "Change href to: " "" yahtml-url-completion-map))
2282 (if (string< "" href)
2283 (progn
2284 ;;(setq href ;??
2285 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))
2286 (delete-region b1 e1)
2287 (goto-char b1)
2288 (insert href))))
2289 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr
2290 (if (and (equal attr "class") ;treat "class" attribute specially
2291 (setq css (yahtml-css-get-element-completion-alist tag)))
2293 (setq new (yahtml-read-css css tag))
2294 ;;other than "class", read parameter normally
2295 (setq new (yahtml-read-parameter attr)))
2296 (goto-char (car (get 'yahtml-on-assignment-p 'region)))
2297 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))
2298 (insert new))
2299 (t
2300 (save-excursion
2301 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))
2302 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))
2303 (skip-chars-forward "^A-Za-z")
2304 (set-marker q (point))
2305 (setq p (point))
2306 (yahtml-goto-corresponding-begend)
2307 (or (= (char-after (point)) ?<)
2308 (skip-chars-backward "^<"))
2309 (skip-chars-forward "^A-Za-z")
2310 (if (= (char-after (1- (point))) ?/)
2311 (progn
2312 (set-marker q (point))
2313 (goto-char p)))
2314 (setq tag (let ((completion-ignore-case t))
2315 (YaTeX-cplread-with-learning
2316 (format "Change `%s' to(default %s): "
2317 tag yahtml-last-begend)
2318 'default 'user 'tmp)))
2319 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
2320 (if (string= "" tag) (setq tag yahtml-last-begend))
2321 (setq yahtml-last-begend
2322 (or (cdr (assoc tag yahtml-env-table)) tag)
2323 tag yahtml-last-begend)
2324 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))
2325 (insert (format "%s%s" tag (yahtml-addin tag)))
2326 (goto-char q)
2327 (set-marker q nil)
2328 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
2329 (insert tag))))
2330 t))))
2332 (defun yahtml-change-command ()
2333 (let ((p (point)) (case-fold-search t) cmd par new
2334 (beg (make-marker)) (end (make-marker)))
2335 (skip-chars-backward "^<")
2336 (if (and
2337 (looking-at yahtml-command-regexp)
2338 (progn
2339 (set-marker beg (match-beginning 0))
2340 (set-marker end (match-end 0))
2341 t) ;for further work
2342 (progn
2343 (forward-char -1)
2344 (condition-case nil
2345 (forward-list 1)
2346 (error nil))
2347 (< p (point))))
2348 (progn
2349 (goto-char p)
2350 (if (setq par (yahtml-on-assignment-p))
2351 (progn
2352 (setq new (yahtml-read-parameter par))
2353 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))
2354 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))
2355 (setq new
2356 (YaTeX-cplread-with-learning
2357 "Change form to: "
2358 'yahtml-form-table 'yahtml-user-form-table
2359 'yahtml-tmp-form-table)))
2360 (delete-region beg end)
2361 (goto-char beg)
2362 (set-marker beg nil)
2363 (set-marker end nil)
2364 (insert new)
2365 t)
2366 (goto-char p)
2367 nil)))
2369 (defun yahtml-change-* ()
2370 "Change current position's HTML tag (set)."
2371 (interactive)
2372 (cond
2373 ((yahtml-change-begend))
2374 ((yahtml-change-command))))
2376 ;;; ---------- commenting ----------
2378 (defun yahtml-comment-region (&optional uncom)
2379 "Comment out region or environment."
2380 (interactive)
2381 (let ((e (make-marker)) be beg p)
2382 (cond
2383 (;(marker-position (set-marker e (yahtml-on-begend-p)))
2384 (setq be (yahtml-on-begend-p))
2385 (save-excursion
2386 (setq p (point))
2387 (if (string-match "^/" be)
2388 (setq beg (progn (forward-line 1) (point)))
2389 (setq beg (progn (beginning-of-line) (point))))
2390 (goto-char p)
2391 (yahtml-goto-corresponding-begend)
2392 (if (string-match "^/" be)
2393 (beginning-of-line)
2394 (forward-line 1))
2395 (set-marker e (point))
2396 ;(comment-region beg (point) (if uncom (list 4)))))
2397 ))
2398 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))
2399 (setq beg (region-beginning))
2400 (set-marker e (region-end))))
2401 (if yahtml-translate-hyphens-when-comment-region
2402 (let ((yahtml-entity-reference-chars-alist-default nil)
2403 (yahtml-entity-reference-chars-alist '((?- . "#45")))
2404 yahtml-entity-reference-chars-regexp
2405 yahtml-entity-reference-chars-reverse-regexp)
2406 (yahtml-entity-reference-chars-setup)
2407 (funcall
2408 (if uncom 'yahtml-translate-reverse-region
2409 'yahtml-translate-region)
2410 beg e)))
2411 (comment-region beg e (if uncom (list 4)))
2412 (set-marker e nil)))
2414 (defun yahtml-uncomment-region ()
2415 (interactive)
2416 (yahtml-comment-region t))
2418 ;;; ---------- translate to entity references ----------
2419 (defvar yahtml-entity-reference-chars-alist-default
2420 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))
2421 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))
2422 "Default translation table from character to entity reference")
2423 (defvar yahtml-entity-reference-chars-alist nil
2424 "*Translation table from character to entity reference")
2425 (defvar yahtml-entity-reference-chars-regexp nil)
2426 (defvar yahtml-entity-reference-chars-reverse-regexp nil)
2428 (defun yahtml-entity-reference-chars-setup ()
2429 (let ((list (append yahtml-entity-reference-chars-alist-default
2430 yahtml-entity-reference-chars-alist)))
2431 (setq yahtml-entity-reference-chars-regexp "["
2432 yahtml-entity-reference-chars-reverse-regexp "&\\(")
2433 (while list
2434 (setq yahtml-entity-reference-chars-regexp
2435 (concat yahtml-entity-reference-chars-regexp
2436 (char-to-string (car (car list))))
2437 yahtml-entity-reference-chars-reverse-regexp
2438 (concat yahtml-entity-reference-chars-reverse-regexp
2439 (cdr (car list))
2440 (if (cdr list) "\\|")))
2441 (setq list (cdr list)))
2442 (setq yahtml-entity-reference-chars-regexp
2443 (concat yahtml-entity-reference-chars-regexp "]")
2444 yahtml-entity-reference-chars-reverse-regexp
2445 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))
2447 (yahtml-entity-reference-chars-setup)
2449 (defun yahtml-translate-region (beg end)
2450 "Translate inhibited literals."
2451 (interactive "r")
2452 (save-excursion
2453 (save-restriction
2454 (narrow-to-region beg end)
2455 (let ((ct (append yahtml-entity-reference-chars-alist
2456 yahtml-entity-reference-chars-alist-default)))
2457 (goto-char beg)
2458 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)
2459 ;(setq c (preceding-char))
2460 (replace-match
2461 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))
2463 (defun yahtml-translate-reverse-region (beg end)
2464 "Translate entity references to literals."
2465 (interactive "r")
2466 (save-excursion
2467 (save-restriction
2468 (narrow-to-region beg end)
2469 (let ((ct (append yahtml-entity-reference-chars-alist
2470 yahtml-entity-reference-chars-alist-default))
2471 ec)
2472 (goto-char beg)
2473 (while (re-search-forward
2474 yahtml-entity-reference-chars-reverse-regexp nil t)
2475 ;(setq c (preceding-char))
2476 (setq ec (YaTeX-match-string 1))
2477 (delete-region (match-end 0) (match-beginning 0))
2478 (insert (car (YaTeX-rassoc ec ct))))))))
2480 (defun yahtml-inner-environment-but (exclude &optional quick)
2481 "Return the inner environment but matches with EXCLUDE tag."
2482 (let (e (case-fold-search t))
2483 (save-excursion
2484 (while (and (setq e (YaTeX-inner-environment quick))
2485 (string-match exclude e))
2486 (goto-char (get 'YaTeX-inner-environment 'point))))
2487 e))
2489 (defun yahtml-untranslate-string (str)
2490 "Untranslate entity reference."
2491 (let ((md (match-data)) (left "") (right str) b0 ch
2492 (ct (append yahtml-entity-reference-chars-alist
2493 yahtml-entity-reference-chars-alist-default))
2494 (revrex yahtml-entity-reference-chars-reverse-regexp))
2495 (unwind-protect
2496 (progn
2497 (while (string< "" right)
2498 (cond
2499 ((string-match revrex right)
2500 (setq ch (YaTeX-rassoc
2501 (substring right (match-beginning 1) (match-end 1)))
2502 b0 (substring right 0 (match-beginning 0))
2503 right (substring right (match-end 0))
2504 left (concat left
2505 (substring right 0 (match-beginning 0))
2506 (char-to-string ch))))
2507 ((string-match "\\&#\\(x\\)?\\([0-9a-f]+\\);" right)
2508 (setq ch (substring right (match-beginning 2) (match-end 2))
2509 b0 (substring right 0 (match-beginning 0))
2510 right (substring right (match-end 0))
2511 left (concat left
2512 b0
2513 (char-to-string
2514 (if (match-beginning 1)
2515 (YaTeX-hex ch)
2516 (string-to-number ch))))))
2517 (t (setq left (concat left right)
2518 right ""))))
2519 left)
2520 (store-match-data md))))
2522 ;;; ---------- table-ize region ----------
2523 (defun yahtml-td-region (e delim beg end)
2524 "Enclose each item in a region with <td>..</td>.
2525 Interactive prefix argument consults enclosing element other than td."
2526 (interactive "P\nsDelimiter(s): \nr")
2527 (let ((e (cond
2528 ((null e) "td")
2529 ((stringp e) e)
2530 (t (read-string-with-history
2531 "Enclose with(`thd' means th td td..): " "th"))))
2532 (ws "[ \t]")
2533 elm p i)
2534 (if (string= delim "") (setq delim " \t\n"))
2535 (setq delim (concat "[" delim "]+")
2536 elm (if (string= "thd" e)
2537 (cons "th" "td")
2538 (cons e e)))
2539 (save-excursion
2540 (save-restriction
2541 (narrow-to-region beg end)
2542 (goto-char (setq p (point-min)))
2543 (setq i 0 e (car elm))
2544 (while (re-search-forward delim nil t)
2545 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))
2546 (goto-char (match-beginning 0))
2547 (insert "</" e ">")
2548 (save-excursion
2549 (goto-char p)
2550 (insert "<" e ">"))
2551 (setq p (point))
2552 (while (and (not (eobp)) (looking-at ws))
2553 (delete-char 1))
2554 (if (looking-at delim) (delete-char 1)))
2555 (insert "<" e ">")
2556 (goto-char (point-max))
2557 (insert "</" e ">")))))
2559 (defun yahtml-tr-region (e delim beg end)
2560 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."
2561 (interactive "P\nsDelimiter(s): \nr")
2562 (setq e (if (and e (listp e))
2563 (read-string-with-history
2564 "Enclose with(td or th, `thd' -> th td td td...: " "th")))
2565 (save-excursion
2566 (save-restriction
2567 (narrow-to-region (point) (mark))
2568 (goto-char (point-min))
2569 (while (not (eobp))
2570 (insert "<tr>")
2571 (yahtml-td-region e delim (point) (point-end-of-line))
2572 (end-of-line)
2573 (insert "</tr>")
2574 (forward-line 1)))))
2576 ;;; ---------- filling ----------
2577 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))
2578 (defun yahtml-move-to-column (col &optional force)
2579 (beginning-of-line)
2580 (let ((ccol 0))
2581 (while (and (> col ccol) (not (eolp)))
2582 (if (eq (following-char) ?\<)
2583 (progn
2584 (while (and (not (eq (following-char) ?\>))
2585 (not (eolp)))
2586 (forward-char))
2587 (or (eolp) (forward-char)))
2588 (or (eolp) (forward-char))
2589 (if (eq (preceding-char) ?\t)
2590 (let ((wd (- 8 (% (+ ccol 8) 8))))
2591 (if (and force (< col (+ ccol wd)))
2592 (progn
2593 (backward-char 1)
2594 (insert-char ?\ (- col ccol))
2595 (setq ccol col))
2596 (setq ccol (+ ccol wd))))
2597 (setq ccol (1+ ccol)))
2598 (if (and YaTeX-japan
2599 (or
2600 (and (fboundp 'char-category)
2601 (string-match "[chj]" (char-category (preceding-char))))
2602 (and (fboundp 'char-charset)
2603 (not (eq (char-charset (preceding-char)) 'ascii)))))
2604 (setq ccol (1+ ccol)))))
2605 (if (and force (> col ccol))
2606 (progn
2607 (insert-char ?\ (- col ccol))
2608 col)
2609 ccol)))
2611 (defun yahtml-fill-paragraph (arg)
2612 (interactive "P")
2613 (let*((case-fold-search t) (p (point)) fill-prefix
2614 (e (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t) "html"))
2615 indent
2616 (startp (get 'YaTeX-inner-environment 'point))
2617 (prep (string-match "^pre$" e))
2618 (ps1 (if prep (default-value 'paragraph-start)
2619 paragraph-start))
2620 (ps2 (if prep (concat (default-value 'paragraph-start)
2621 "$\\|^\\s *</?pre>")
2622 paragraph-start)))
2623 (save-excursion
2624 (unwind-protect
2625 (progn
2626 (if prep
2627 (fset 'move-to-column 'yahtml-move-to-column))
2628 (save-excursion
2629 (beginning-of-line)
2630 (indent-to-column (yahtml-this-indent))
2631 (setq fill-prefix
2632 (buffer-substring (point) (point-beginning-of-line)))
2633 (delete-region (point) (point-beginning-of-line)))
2634 (fill-region-as-paragraph
2635 (progn (re-search-backward paragraph-start nil t)
2636 (or (save-excursion
2637 (goto-char (match-beginning 0))
2638 (if (looking-at "<")
2639 (forward-list)
2640 (goto-char (match-end 0))
2641 (skip-chars-forward " \t>"))
2642 (if (looking-at "[ \t]*$")
2643 (progn (forward-line 1) (point))))
2644 (point)))
2645 (progn (goto-char p)
2646 (re-search-forward ps2 nil t)
2647 (match-beginning 0))))
2648 (fset 'move-to-column yahtml-saved-move-to-column)))))
2650 ;;;
2651 ;;; ---------- move forward/backward field ----------
2652 ;;;
2653 (defun yahtml-element-path ()
2654 "Return the element path from <body> at point as a list"
2655 (let (path elm)
2656 (save-excursion
2657 (while (and (YaTeX-beginning-of-environment)
2658 (looking-at (concat "<\\(" yahtml-command-regexp "\\)\\>"))
2659 (not (string= (setq elm (downcase (YaTeX-match-string 1)))
2660 "body")))
2661 (setq path (cons elm path)
2662 elm nil))
2663 (and elm (setq path (cons elm path)))
2664 path)))
2666 (defun yahtml-forward-field (arg)
2667 "Move ARGth forward cell to table element.
2668 ENVINFO is a cons of target element name and its beginning point."
2669 (interactive "p")
2670 (let (inenv elm path sibs)
2671 (cond
2672 ((< arg 0) (yahtml-backward-field (- arg)))
2673 ((= arg 0) nil)
2674 ((and (setq path (nreverse (yahtml-element-path)))
2675 (catch 'sibling
2676 (while path
2677 (if (setq elm (car-safe
2678 (member (car path) '("td" "th" "li" "dt" "dd"))))
2679 (throw 'sibling elm))
2680 (setq path (cdr path)))))
2681 (setq inenv (YaTeX-in-environment-p elm)
2682 sibs (cdr (assoc elm '(("td" . "td\\|th")
2683 ("th" . "td\\|th")
2684 ("li" . "li")
2685 ("dt" . "dt\\|dd")
2686 ("dd" . "dt\\|dd")))))
2687 (goto-char (cdr inenv))
2688 (while (>= (setq arg (1- arg)) 0)
2689 (yahtml-goto-corresponding-begend)
2690 (if (looking-at "<") (forward-list 1))
2691 (skip-chars-forward "^<"))
2692 (while (looking-at "\\s \\|\\(</\\)")
2693 (if (match-beginning 1) (forward-list 1)
2694 (skip-chars-forward "\n\t ")))
2695 (forward-list 1) ;; step into environment
2696 (skip-chars-forward " \t\n")
2697 (if (looking-at (concat "<\\(" sibs "\\)\\>"))
2698 (forward-list 1))
2699 ))))
2702 ;;;
2703 ;;; ---------- indentation ----------
2704 ;;;
2705 (defun yahtml-indent-line-1 ()
2706 "Indent a line (faster wrapper)"
2707 (interactive)
2708 (let (indent)
2709 (if (and (save-excursion
2710 (beginning-of-line) (skip-chars-forward "\t ")
2711 (not (looking-at "<")))
2712 (save-excursion
2713 (forward-line -1)
2714 (while (and (not (bobp)) (looking-at "^\\s *$"))
2715 (forward-line -1))
2716 (skip-chars-forward "\t ")
2717 (setq indent (current-column))
2718 (not (looking-at "<"))))
2719 (progn
2720 (save-excursion
2721 (beginning-of-line)
2722 (skip-chars-forward " \t")
2723 (or (= (current-column) indent)
2724 (YaTeX-reindent indent)))
2725 (and (bolp) (skip-chars-forward " \t")))
2726 (yahtml-indent-line-real))))
2728 (defun yahtml-indent-line ()
2729 "Indent a line (Second level wrapper).
2730 See also yahtml-indent-line-1 and yahtml-indent-line-real."
2731 (interactive)
2732 (let ((cc (current-column)) (p (point)))
2733 (yahtml-indent-line-1)
2734 (and (= cc (current-column))
2735 (= p (point))
2736 (equal last-command 'yahtml-indent-line)
2737 (yahtml-forward-field 1))))
2740 (defun yahtml-this-indent ()
2741 (let ((envs "[uod]l\\|table\\|[ht][rhd0-6]\\|select\\|blockquote\\|center\\|menu\\|dir\\|d[td]\\|li")
2742 (itemizing-envs "^\\([uod]l\\|menu\\|dir\\|li\\|d[td]\\)$")
2743 (itms "<\\(dt\\|dd\\|li\\|t[rdh]\\|option\\)\\b")
2744 (excludes
2745 "\\b\\(a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\\)\\b")
2746 inenv p col peol (case-fold-search t))
2747 (save-excursion
2748 (beginning-of-line)
2749 (setq inenv (or (yahtml-inner-environment-but excludes t)
2750 "html")
2751 col (get 'YaTeX-inner-environment 'indent)
2752 p (get 'YaTeX-inner-environment 'point)
2753 op nil))
2754 (save-excursion
2755 (cond
2756 ((string-match (concat "^\\(" envs "\\)") inenv)
2757 (save-excursion
2758 (beginning-of-line)
2759 (skip-chars-forward " \t")
2760 (cond ;lookup current line's tag
2761 ((looking-at (concat "</\\(" envs "\\)>"))
2762 col)
2763 ((looking-at itms)
2764 (+ col yahtml-environment-indent))
2765 ((and yahtml-hate-too-deep-indentation
2766 (looking-at (concat "<\\(" envs "\\)")))
2767 (+ col (* 2 yahtml-environment-indent)))
2768 ((and (< p (point))
2769 (string-match itemizing-envs inenv)
2770 (save-excursion
2771 (and
2772 (setq op (point))
2773 (goto-char p)
2774 (re-search-forward itms op t)
2775 (progn
2776 (if yahtml-indent-listing-constant
2777 (setq col (+ (current-column)
2778 (if yahtml-faithful-to-htmllint 1 2)))
2779 (skip-chars-forward "^>")
2780 (skip-chars-forward ">")
2781 (skip-chars-forward " \t")
2782 (setq col (if (looking-at "$")
2783 (+ col yahtml-environment-indent)
2784 (current-column))))))))
2785 col)
2786 (t
2787 (+ col yahtml-environment-indent)))))
2788 (t col)))))
2790 (defun yahtml-indent-line-real ()
2791 "Indent current line."
2792 (interactive)
2793 (YaTeX-reindent (yahtml-this-indent))
2794 (if (bolp) (skip-chars-forward " \t"))
2795 (let (peol col inenv)
2796 (if (and (setq inenv (yahtml-on-begend-p))
2797 (string-match
2798 (concat "^\\<\\(" yahtml-struct-name-regexp "\\)") inenv))
2799 (save-excursion
2800 (setq peol (point-end-of-line))
2801 (or (= (char-after (point)) ?<)
2802 (progn (skip-chars-backward "^<") (forward-char -1)))
2803 (setq col (current-column))
2804 (if (and (yahtml-goto-corresponding-begend t)
2805 (> (point) peol)) ;if on the different line
2806 (YaTeX-reindent col))))))
2808 ;(defun yahtml-fill-item ()
2809 ; "Fill item HTML version"
2810 ; (interactive)
2811 ; (let (inenv p fill-prefix peol (case-fold-search t))
2812 ; (setq inenv (or (YaTeX-inner-environment) "html")
2813 ; p (get 'YaTeX-inner-environment 'point))
2814 ; (cond
2815 ; ((string-match "^[uod]l" inenv)
2816 ; (save-excursion
2817 ; (if (re-search-backward "<\\(d[td]\\|li\\)>[ \t\n]*" p t)
2818 ; (progn
2819 ; (goto-char (match-end 0))
2820 ; (setq col (current-column)))
2821 ; (error "No <li>, <dt>, <dd>")))
2822 ; (save-excursion
2823 ; (end-of-line)
2824 ; (setq peol (point))
2825 ; (newline)
2826 ; (indent-to-column col)
2827 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))
2828 ; (delete-region (point) peol)
2829 ; (fill-region-as-paragraph
2830 ; (progn (re-search-backward paragraph-start nil t) (point))
2831 ; (progn (re-search-forward paragraph-start nil t 2)
2832 ; (match-beginning 0)))))
2833 ; (t nil))))
2835 ;;;
2836 ;;; ---------- Lint and Browsing ----------
2837 ;;;
2838 (defun yahtml-browse-menu ()
2839 "Browsing or other external process invokation menu."
2840 (interactive)
2841 (message "J)weblint p)Browse R)eload N)ewpage...")
2842 (let ((c (char-to-string (read-char))))
2843 (cond
2844 ((string-match "j" c)
2845 (yahtml-lint-buffer (current-buffer)))
2846 ((string-match "[bp]" c)
2847 (yahtml-browse-current-file))
2848 ((string-match "r" c)
2849 (yahtml-browse-reload))
2850 ((string-match "n" c)
2851 (call-interactively 'yahtml-newpage)))))
2853 (if (fboundp 'wrap-function-to-control-ime)
2854 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))
2856 (defvar yahtml-lint-buffer "*weblint*")
2858 (defun yahtml-lint-buffer (buf)
2859 "Call lint on buffer BUF."
2860 (require 'yatexprc)
2861 (interactive "bCall lint on buffer: ")
2862 (setq buf (get-buffer buf))
2863 (YaTeX-save-buffers)
2864 (let ((bcmd (YaTeX-get-builtin "lint")))
2865 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))
2866 (YaTeX-typeset
2867 (concat (or bcmd yahtml-lint-program)
2868 " " (file-name-nondirectory (buffer-file-name buf)))
2869 yahtml-lint-buffer "lint" "lint")))
2871 (defun yahtml-file-to-url (file)
2872 "Convert local unix file name to URL.
2873 If no matches found in yahtml-path-url-alist, return raw file name."
2874 (let ((list yahtml-path-url-alist) p url)
2875 (if (file-directory-p file)
2876 (setq file (expand-file-name yahtml-directory-index file))
2877 (setq file (expand-file-name file)))
2878 (if (string-match "^[A-Za-z]:/" file)
2879 (progn
2880 ;; (aset file 1 ?|) ;これは要らないらしい…
2881 (setq file (concat "///" file))))
2882 (while list
2883 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)
2884 (setq url (cdr (car list))
2885 file (substring file (match-end 0))
2886 url (concat url file)
2887 list nil))
2888 (setq list (cdr list)))
2889 (or url (concat "file:" file))))
2891 (defun yahtml-url-to-path (file &optional basedir)
2892 "Convert local URL name to unix file name."
2893 (let ((list yahtml-path-url-alist) url realpath docroot
2894 (dirsufp (string-match "/$" file)))
2895 (setq basedir (or basedir
2896 (file-name-directory
2897 (expand-file-name default-directory))))
2898 (cond
2899 ((string-match "^/" file)
2900 (while list
2901 (if (file-directory-p (car (car list)))
2902 (progn
2903 (setq url (cdr (car list)))
2904 (if (string-match "\\(https?://[^/]*\\)/" url)
2905 (setq docroot (substring url (match-end 1)))
2906 (setq docroot url))
2907 (cond
2908 ((string-match (concat "^" (regexp-quote docroot)) file)
2909 (setq realpath
2910 (expand-file-name
2911 (substring
2912 file
2913 (if (= (aref file (1- (match-end 0))) ?/)
2914 (match-end 0) ; "/foo"
2915 (min (1+ (match-end 0)) (length file)))) ; "/~foo"
2916 (car (car list))))))
2917 (if realpath
2918 (progn (setq list nil)
2919 (if (and dirsufp (not (string-match "/$" realpath)))
2920 (setq realpath (concat realpath "/")))))))
2921 (setq list (cdr list)))
2922 realpath)
2923 (t file))))
2925 (defun yahtml-browse-current-file ()
2926 "Call WWW browser on current file."
2927 (interactive)
2928 (basic-save-buffer)
2929 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))
2931 (defun yahtml-browse-reload ()
2932 "Send `reload' event to netscape."
2933 (let ((pb "* WWW Browser *") (cb (current-buffer)))
2934 (cond
2935 ((string-match "[Nn]etscape" yahtml-www-browser)
2936 (if (get-buffer pb)
2937 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
2938 ;;(or (get 'yahtml-netscape-sentinel 'url)
2939 ;; (error "Reload should be called after Browsing."))
2940 (put 'yahtml-netscape-sentinel 'url
2941 (yahtml-file-to-url (buffer-file-name)))
2942 (basic-save-buffer)
2943 (set-process-sentinel
2944 (setq yahtml-browser-process
2945 (start-process
2946 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
2947 (format "%s -remote 'reload'" yahtml-www-browser)))
2948 'yahtml-netscape-sentinel))
2949 (t
2950 (message "Sorry, RELOAD is supported only for Netscape.")))))
2952 ;;; ---------- Intelligent newline ----------
2953 (defun yahtml-intelligent-newline (arg)
2954 "Intelligent newline for HTML"
2955 (interactive "P")
2956 (let (env func)
2957 (end-of-line)
2958 (setq env (downcase (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t)
2959 "html")))
2960 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))
2961 (newline)
2962 (if (and env func (fboundp func))
2963 ;; if intelligent line function is defined, call that
2964 (funcall func)
2965 ;; else do the default action
2966 (if (string-match yahtml-p-prefered-env-regexp env)
2967 (yahtml-insert-p)))))
2969 (defun yahtml-intelligent-newline-ul ()
2970 (interactive)
2971 (yahtml-insert-single "li")
2972 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))
2973 (yahtml-indent-line))
2975 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)
2977 (defun yahtml-intelligent-newline-datalist ()
2978 (interactive)
2979 (yahtml-insert-form "option")
2980 (save-excursion (yahtml-insert-form "/option")))
2982 (defun yahtml-intelligent-newline-dl ()
2983 (interactive)
2984 (let ((case-fold-search t))
2985 (if (save-excursion
2986 (re-search-backward "<\\(\\(dt\\)\\|\\(dd\\)\\)[ \t>]"
2987 (get 'YaTeX-inner-environment 'point) t))
2988 (cond
2989 ((match-beginning 2)
2990 (yahtml-insert-single "dd")
2991 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))
2992 (setq yahtml-last-single-cmd "dt"))
2993 ((match-beginning 3)
2994 (yahtml-insert-single "dt")
2995 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))
2996 (setq yahtml-last-single-cmd "dd")))
2997 (yahtml-insert-single "dt")
2998 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))
2999 (setq yahtml-last-single-cmd "dd"))
3000 (yahtml-indent-line)
3001 (and (string-match yahtml-p-prefered-env-regexp "dl")
3002 (string-equal yahtml-last-single-cmd "dt")
3003 (yahtml-insert-p nil))))
3005 (defun yahtml-intelligent-newline-select ()
3006 (interactive)
3007 (yahtml-insert-single (if yahtml-prefer-upcases "OPTION" "option"))
3008 (yahtml-indent-line))
3010 (defun yahtml-intelligent-newline-style ()
3011 (interactive)
3012 (if (save-excursion
3013 (and
3014 (re-search-backward "<style\\|<!-- " nil t)
3015 (looking-at "<style")))
3016 (let (c)
3017 (yahtml-indent-line)
3018 (setq c (current-column))
3019 (insert "<!--\n")
3020 (YaTeX-reindent c)
3021 (insert "-->")
3022 (beginning-of-line)
3023 (open-line 1)
3024 (YaTeX-reindent c))))
3026 (defun yahtml-intelligent-newline-head ()
3027 (let ((title (read-string-with-history "Document title: "))
3028 (b "<title>") (e "</title>") p)
3029 (yahtml-indent-line)
3030 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))
3031 (setq p (point))
3032 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))
3033 (if (string= "" title) (goto-char p))
3034 (setq yahtml-last-begend "body")))
3036 (defun yahtml-intelligent-newline-script ()
3037 (let ((p (point)) b)
3038 (if (save-excursion
3039 (and
3040 (setq b (re-search-backward "<script\\>" nil t))
3041 (re-search-forward
3042 "\\(javascript\\)\\|\\(tcl\\)\\|\\(vbscript\\)" p t)))
3043 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))
3044 c (srcp (re-search-backward "src=" b t)))
3045 (goto-char p)
3046 (yahtml-indent-line)
3047 (setq c (current-column))
3048 (if srcp
3049 nil
3050 (insert "<!--\n" (cond (js "//") (tcl "#") (vb "'")) " -->")
3051 (beginning-of-line)
3052 (open-line 1)
3053 (YaTeX-reindent c))))))
3055 (defun yahtml-intelligent-newline-table ()
3056 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt
3057 (ptn "\\(<t[dh]\\>\\)\\|<t\\(r\\|head\\|body\\)\\>"))
3058 (cond
3059 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))
3060 (while (and (setq rb (re-search-backward ptn tb t))
3061 (match-beginning 1))
3062 (setq th (looking-at "<th")) ;Remember if first-child is tr or not
3063 (goto-char (match-end 0))
3064 (skip-chars-forward " \t\n")
3065 (if (and (search-forward "colspan\\s *=" p t)
3066 (progn
3067 (skip-chars-forward "\"' \t\n")
3068 (looking-at "[0-9]+")))
3069 (setq cols (+ (YaTeX-str2int (YaTeX-match-string 0)) cols))
3070 (setq cols (1+ cols)))
3071 (goto-char rb)
3072 (setq p (point)))
3073 (if (> cols 0)
3074 (message "%s columns found. %s"
3075 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "
3076 "New tr?(N) or Duplicate")))
3077 (cond
3078 ((and (> cols 0)
3079 (memq (read-char) '(?d ?D))) ;Duplication mode
3080 (setq line (YaTeX-buffer-substring (point) (1- cp))))
3081 (t ;empty cells
3082 (setq line "<tr>" i 0)
3083 (if (> cols 0)
3084 (while (> cols i)
3085 (setq line (concat line (if (and (= i 0) th) "<th></th>"
3086 "<td></td>"))
3087 th nil i (1+ i)))
3088 (setq fmt (read-string-with-history
3089 "`th' or `td' format: " "th td td"))
3090 (while (string-match "t\\(h\\)\\|td" fmt i)
3091 (setq line (concat line (if (match-beginning 1) "<th></th>"
3092 "<td></td>"))
3093 i (match-end 0))))
3094 (setq line (concat line "</tr>"))))
3095 (goto-char cp)
3096 (if th
3097 (message
3098 "Type `%s' to change td from/to th."
3099 (key-description (car (where-is-internal 'yahtml-change-*)))))
3100 (if (string< "" line)
3101 (progn
3102 (insert line)
3103 (goto-char (+ 8 cp))
3104 (yahtml-indent-line)))))))
3106 (defun yahtml-intelligent-newline-audio ()
3107 (let (b e)
3108 (if (save-excursion
3109 (goto-char (setq b (get 'YaTeX-inner-environment 'point)))
3110 (forward-list 1)
3111 (setq e (point))
3112 (catch 'src
3113 (while (re-search-forward "\\s src\\>" e t)
3114 (skip-chars-forward " \t\n")
3115 (and (looking-at "=") (throw 'src t)))))
3116 ;; if src= attribute found, do nothing
3117 (setq yahtml-last-begend "p")
3118 (yahtml-insert-single "source")
3119 )))
3120 (fset 'yahtml-intelligent-newline-video 'yahtml-intelligent-newline-audio)
3122 (defun yahtml-intelligent-newline-iframe ()
3123 (insert "<p>Your browser does not support iframes.</p>"))
3125 ;;; ---------- Marking ----------
3126 (defun yahtml-mark-begend ()
3127 "Mark current tag"
3128 (interactive)
3129 (YaTeX-beginning-of-environment)
3130 (let ((p (point)))
3131 (save-excursion
3132 (skip-chars-backward " \t" (point-beginning-of-line))
3133 (if (bolp) (setq p (point))))
3134 (push-mark p t))
3135 (yahtml-goto-corresponding-begend)
3136 (forward-list 1)
3137 (if (eolp) (forward-char 1)))
3139 ;;; ---------- complete marks ----------
3140 (defun yahtml-char-entity-ref ()
3141 "Complete &gt;, &lt;, &amp;, and &quot;."
3142 (interactive)
3143 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")
3144 (let ((c (read-char)) d)
3145 (setq d (if (or (< c ?0) (> c ?7))
3146 (string-match (regexp-quote (char-to-string c)) "<>&\"' ")
3147 (- c ?1)))
3148 (cond
3149 ((null d) (insert (format "&#x%x;" c)))
3150 ((and (>= d 0) (<= d 6))
3151 (insert (format "&%s;"
3152 (nth d '("lt" "gt" "amp" "quot" "apos" "nbsp"))))))))
3155 ;;; ---------- jump to error line ----------
3156 (defun yahtml-prev-error ()
3157 "Jump to previous error seeing lint buffer."
3158 (interactive)
3159 (or (get-buffer yahtml-lint-buffer)
3160 (error "No lint program ran."))
3161 (YaTeX-showup-buffer yahtml-lint-buffer nil t)
3162 (yahtml-jump-to-error-line t))
3164 (defun yahtml-jump-to-error-line (&optional sit)
3165 (interactive "P")
3166 (let ((p (point)) (e (point-end-of-line)))
3167 (end-of-line)
3168 (if (re-search-backward yahtml-error-line-regexp nil t)
3169 (let ((f (if (string= "" (YaTeX-match-string 1))
3170 YaTeX-current-file-name
3171 (YaTeX-match-string 1)))
3172 (l (YaTeX-str2int (or (YaTeX-match-string 2)
3173 (YaTeX-match-string 3)))))
3174 (if sit (sit-for 1))
3175 (forward-line -1)
3176 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)
3177 (goto-line l))
3178 (message "No line number usage"))))
3180 ;;; ---------- Style Sheet Support ----------
3181 (defvar yahtml-css-class-alist nil
3182 "Alist of elements vs. their classes")
3184 (defun yahtml-css-collect-classes-region (beg end &optional initial)
3185 (save-excursion
3186 (save-restriction
3187 (narrow-to-region beg end)
3188 (goto-char (point-min))
3189 (let ((alist initial) b e element class a)
3190 (setq b (point))
3191 (while (re-search-forward "\\({\\)\\|\\(@import\\)" nil t)
3192 (if (match-beginning 2)
3193 (let ((f (YaTeX-buffer-substring
3194 (progn (skip-chars-forward "^\"")(1+ (point)))
3195 (progn (forward-char 1)
3196 (skip-chars-forward "^\"")(point)))))
3197 (if (file-exists-p f)
3198 (setq alist
3199 (append alist (yahtml-css-collect-classes-file
3200 f initial)))))
3201 (setq e (point))
3202 (goto-char b)
3203 (while (re-search-forward ;ちょといい加減なREGEXP
3204 "\\([a-z*][-a-z0-9]*\\)?\\.\\([-a-z0-9][-a-z0-9]*\\)\\>"
3205 e t)
3206 (setq element (YaTeX-match-string 1)
3207 class (YaTeX-match-string 2))
3208 ;;if starts with period (match-string 1 is nil),
3209 ;;this is global class
3210 (setq element (downcase (or element "*")))
3211 (if (setq a (assoc element alist))
3212 (or (assoc class (cdr a))
3213 (setcdr a (cons (list class) (cdr a))))
3214 (setq alist (cons (list element (list class)) alist))))
3215 (goto-char (1- e))
3216 (search-forward "}" nil 1) ;1=move to limit when not found.
3217 (setq b (point))))
3218 alist))))
3220 (defun yahtml-css-collect-classes-buffer (&optional initial)
3221 (interactive)
3222 (yahtml-css-collect-classes-region (point-min) (point-max) initial))
3224 (defun yahtml-css-collect-classes-file (file &optional initial)
3225 (let*((hilit-auto-highlight nil)
3226 (buf (get-buffer-create
3227 (format " *css-collection*%s" (file-name-nondirectory file))))
3228 (cb (current-buffer)))
3229 (unwind-protect
3230 (progn
3231 (set-buffer buf)
3232 (insert-file-contents file)
3233 (cd (or (file-name-directory file) "."))
3234 (yahtml-css-collect-classes-buffer initial))
3235 (if (eq buf cb)
3236 nil
3237 (kill-buffer buf)
3238 (set-buffer cb)))))
3240 (defun yahtml-css-scan-styles ()
3241 (save-excursion
3242 (goto-char (point-min))
3243 (set (make-local-variable 'yahtml-css-class-alist) nil)
3244 (let (b tag type e href alist)
3245 (while (re-search-forward "<\\(style\\|link\\)" nil t)
3246 (setq b (match-beginning 0)
3247 tag (YaTeX-match-string 1))
3248 (cond
3249 ((string-match "style" tag)
3250 (goto-char b)
3251 (save-excursion (forward-list 1) (setq e (point)))
3252 (cond
3253 ((search-forward "text/css" e 1) ;css definition starts
3254 (setq alist
3255 (yahtml-css-collect-classes-region
3256 (point) (progn (search-forward "</style>") (point))
3257 alist)))))
3258 ((and (string-match "link" tag)
3259 (stringp (setq type (yahtml-get-attrvalue "type")))
3260 (string-match "text/css" type)
3261 (setq href (yahtml-get-attrvalue "href"))
3262 (file-exists-p (yahtml-url-to-path href)))
3263 (setq alist
3264 (yahtml-css-collect-classes-file
3265 (yahtml-url-to-path href) alist))))
3266 (setq yahtml-css-class-alist alist)))))
3268 (defun yahtml-css-get-element-completion-alist (element)
3269 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))
3270 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))
3271 (and (or alist global)
3272 (append alist global))))
3274 ;;; ---------- ----------
3276 ;;;
3277 ;;hilit19
3278 ;;;
3279 (defvar yahtml-default-face-table
3280 '(
3281 (form black/ivory white/hex-442233 italic)
3282 ))
3283 (defvar yahtml-hilit-patterns-alist
3284 '(
3285 'case-fold
3286 ;; comments
3287 ("<!--\\s " "-->" comment)
3288 ;; include&exec
3289 ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\)" "-->" include)
3290 ;; string
3291 (hilit-string-find ?\\ string)
3292 (yahtml-hilit-region-tag "<\\(strong\\|b\\)\\>" bold)
3293 ("</?[uod]l>" 0 decl)
3294 ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
3295 (yahtml-hilit-region-tag "<\\(em\\|i\\>\\)" italic)
3296 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..
3297 (yahtml-hilit-region-tag "<\\(a\\)\\s +href" crossref)
3298 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
3299 ))
3301 (defun yahtml-hilit-region-tag (tag)
3302 "Return list of start/end point of <TAG> form."
3303 (if (re-search-forward tag nil t)
3304 (let ((m0 (match-beginning 0)) (e0 (match-end 0))
3305 (elm (YaTeX-match-string 1)))
3306 (skip-chars-forward "^>")
3307 (prog1
3308 (cons (1+ (point))
3309 (progn (re-search-forward (concat "</" elm ">") nil t)
3310 (match-beginning 0)))
3311 (goto-char e0)))))
3313 (defun yahtml-hilit-region-tag-itself (ptn)
3314 "Return list of start/end point of <tag options...> itself."
3315 (if (re-search-forward ptn nil t)
3316 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))
3317 (skip-chars-forward "^<>")
3318 (if (eq (char-after (point)) ?<) nil
3319 (prog1
3320 (cons m0 (min (point-max) (1+ (point))))
3321 (goto-char e0))))))
3323 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))
3324 (and yahtml-use-hilit19
3325 (or (assq 'yahtml-mode hilit-patterns-alist)
3326 (setq hilit-patterns-alist
3327 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
3328 hilit-patterns-alist))))
3329 ;;;
3330 ;; for font-lock
3331 ;;;
3333 ; <<STATIC KEYWORDS BELOW NOT USED>>
3334 ;(defvar yahtml-font-lock-keywords
3335 ; '(
3336 ; ;; comments
3337 ; ("<!--\\s .* -->" . font-lock-comment-face)
3338 ; ;; include&exec
3339 ; ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\).*-->"
3340 ; 0 font-lock-include-face keep)
3341 ; ;; string
3342 ; ;(hilit-string-find ?\\ string)
3343 ; ;(yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
3344 ; ("</?[uod]l>" 0 font-lock-keyword-face)
3345 ; ("<\\(di\\|dt\\|li\\|dd\\)>" 0 font-lock-label-face)
3346 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))
3347 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
3348 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))
3349 ; )
3350 ; "*Defualt font-lock-keywords for yahtml-mode.")
3351 (defvar yahtml-font-lock-keywords
3352 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)
3353 "Default fontifying patterns for yahtml-mode")
3355 (defun yahtml-font-lock-set-default-keywords ()
3356 (put 'yahtml-mode 'font-lock-defaults
3357 '(yahtml-font-lock-keywords nil t)))
3359 (if yahtml-use-font-lock
3360 (progn
3361 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
3362 ;;for those who use both hilit19 and font-lock
3363 (if (eq (car hilit-mode-enable-list) 'not)
3364 (or (member 'yahtml-mode hilit-mode-enable-list)
3365 (nconc hilit-mode-enable-list (list 'yahtml-mode)))
3366 (setq hilit-mode-enable-list
3367 (delq 'yahtml-mode hilit-mode-enable-list))))
3368 (yahtml-font-lock-set-default-keywords)))
3370 (defun yahtml-font-lock-recenter (&optional arg)
3371 (interactive "P")
3372 (font-lock-mode -1) ;is stupid, but sure.
3373 (font-lock-mode 1))
3375 ;;;
3376 ;; Drag-n-Drop
3377 ;;;
3378 (defun yahtml-dnd-handler (uri action)
3379 "DnD handler for yahtml mode
3380 Convert image URI to img-src and others to a-href."
3381 (let*((file (dnd-get-local-file-name uri))
3382 (path (if file (file-relative-name file) uri))
3383 (case-fold-search t)
3384 (geom ""))
3385 (cond
3386 ((memq action '(copy link move private))
3387 (cond
3388 ((string-match "\\.\\(jpe?g\\|png\\|gif\\|bmp\\|tiff?\\)$" path)
3389 (if file
3390 (setq geom (yahtml-get-image-info path)
3391 geom (if (car geom)
3392 (apply 'format " width=\"%s\" height=\"%s\"" geom)
3393 "")))
3394 (insert (format "<img src=\"%s\" alt=\"%s\"%s>"
3395 path (file-name-nondirectory path) geom)))
3397 (t (insert (format "<a href=\"%s\"></a>" path))
3398 (forward-char -4))))
3399 (t (message "No handler for action `%s'" action))))
3400 action)
3402 (run-hooks 'yahtml-load-hook)
3403 (provide 'yahtml)
3405 ; Local variables:
3406 ; fill-prefix: ";;; "
3407 ; paragraph-start: "^$\\| \\|;;;$"
3408 ; paragraph-separate: "^$\\| \\|;;;$"
3409 ; End: