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