yatex

view yahtml.el @ 283:95e8bb2a5c5f

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