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