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