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