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