yatex: bf201e406e3f yahtml.el

yatex

view yahtml.el @ 286:bf201e406e3f

First line header changed. Abolish `rev.' line. Using YaTeX-revision-number line instead.

author	HIROSE Yuuji <yuuji@gentei.org>
date	Sat, 01 Sep 2012 08:00:58 +0900
parents	d467c0fb6083
children	1a4332ecc58b

line source

1 ;;; yahtml.el --- Yet Another HTML mode -*- coding: sjis -*-

3 ;;; Last modified Sat Sep 1 07:28:17 2012 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.76"

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 ;;;

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 ;;;

180

181 ;;; Code:

182

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))))

198

199 (defvar yahtml-fill-column 72 "*fill culumn used for yahtml-mode")

200 (defvar yahtml-fill-prefix nil "*fill prefix for yahtml-mode")

201

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.")

211

212 (defvar yahtml-environment-indent 1

213 "*Indentation depth of HTML's listing environment")

214

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.")

220

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.")

229

230 (defvar yahtml-p-prefered-env-regexp "^\$body\\|dl\\|blockquote\$"

231 "*Regexp of envs where paragraphed sentences are prefered.")

232

233 (defvar yahtml-template-file "~/public_html/template.html"

234 "*Template HTML file. It'll be inserted to empty file.")

235

236 (defvar yahtml-prefer-upcases nil

237 "*Non-nil for preferring upcase TAGs")

238

239 (defvar yahtml-prefer-upcase-attributes nil

240 "*Non-nil for preferring upcase attributes")

241

242 (defvar yahtml-server-type 'apache "*WWW server program type")

243

244 (defvar yahtml-apache-access-file ".htaccess"

245 "*Server access file name for apache")

246

247 (defvar yahtml-use-css t "*Use stylesheet or not")

248

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")

255

256 (defvar yahtml-faithful-to-htmllint yahtml-always-/li

257 "*Non-nil doesn't put space after opening tags.")

258

259 (defvar yahtml-error-line-regexp

260 "^\$.*\$(\$[0-9]+\$):\\|^line \$[0-9]+\$"

261 "*Regexp of error position which is produced by lint program.")

262

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.")

269

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.")

273

274 (defvar yahtml-use-hilit19 (and (featurep 'hilit19)

275 (not yahtml-use-font-lock))

276 "*Non-nil means to Use hilit19 to highlight buffer")

277

278 (defvar yahtml-mode-abbrev-table nil

279 "*Abbrev table in use in yahtml-mode buffers.")

280 (define-abbrev-table 'yahtml-mode-abbrev-table ())

281

282 (defvar yahtml-indentation-boundary "^\\s *<h[1-3]>"

283 "*Boundary regexp for indentation calculation.")

284

285 (defvar yahtml-html4-strict t

286 "*Non-nil means editing HTML 4.01 Strict.

287 Completing read for obsoleted attributes disabled.")

288

289 ;;; --- customizable variable ends here ---

290 (defvar yahtml-prefix-map nil)

291 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")

292 (defvar yahtml-lint-buffer-map nil "Keymap used in lint buffer.")

293 (defvar yahtml-shell-command-option

294 (or (and (boundp 'shell-command-option) shell-command-option)

295 (if (eq system-type 'ms-dos) "/c" "-c")))

296 (defvar yahtml-use-highlighting (or yahtml-use-font-lock yahtml-use-hilit19))

297

298 (defun yahtml-define-begend-key-normal (key env &optional map)

299 "Define short cut yahtml-insert-begend key."

300 (YaTeX-define-key

301 key

302 (list 'lambda '(arg) '(interactive "P")

303 (list 'yahtml-insert-begend 'arg env))

304 map))

305

306 (defun yahtml-define-begend-region-key (key env &optional map)

307 "Define short cut yahtml-insert-begend-region key."

308 (YaTeX-define-key key (list 'lambda nil '(interactive)

309 (list 'yahtml-insert-begend t env)) map))

310

311 (defun yahtml-define-begend-key (key env &optional map)

312 "Define short cut key for begin type completion both for

313 normal and region mode. To customize yahtml, user should use this function."

314 (yahtml-define-begend-key-normal key env map)

315 (if YaTeX-inhibit-prefix-letter nil

316 (yahtml-define-begend-region-key

317 (concat (upcase (substring key 0 1)) (substring key 1)) env map)))

318

319 (if yahtml-mode-map nil

320 (setq yahtml-mode-map (make-sparse-keymap)

321 yahtml-prefix-map (make-sparse-keymap))

322 (define-key yahtml-mode-map yahtml-prefix yahtml-prefix-map)

323 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)

324 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)

325 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))

326 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)

327 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)

328 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)

329 (define-key yahtml-mode-map "\M-\C-j" 'yahtml-intelligent-newline)

330 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)

331 (define-key yahtml-mode-map "&" 'yahtml-insert-amps)

332 (let ((map yahtml-prefix-map))

333 (YaTeX-define-key "^" 'yahtml-visit-main map)

334 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)

335 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)

336 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)

337 (and YaTeX-emacs-19 window-system

338 (progn

339 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)

340 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)

341 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))

342 (YaTeX-define-key "v" 'yahtml-version map)

343 (YaTeX-define-key "s" 'yahtml-insert-form map)

344 (YaTeX-define-key "l" 'yahtml-insert-tag map)

345 (YaTeX-define-key "L" 'yahtml-insert-tag-region map)

346 (YaTeX-define-key "m" 'yahtml-insert-single map)

347 (YaTeX-define-key "n" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<BR>" "<br>"))) map)

348 (YaTeX-define-key "-" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<HR>" "<hr>") "\n")) map)

349 (YaTeX-define-key "p" 'yahtml-insert-p map)

350 (if YaTeX-no-begend-shortcut

351 (progn

352 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)

353 (YaTeX-define-key "b" 'yahtml-insert-begend map))

354 (yahtml-define-begend-key "bh" "html" map)

355 (yahtml-define-begend-key "bH" "head" map)

356 (yahtml-define-begend-key "bt" "title" map)

357 (yahtml-define-begend-key "bT" "table" map)

358 (yahtml-define-begend-key "bb" "body" map)

359 (yahtml-define-begend-key "bc" "center" map)

360 (yahtml-define-begend-key "bd" "dl" map)

361 (yahtml-define-begend-key "bu" "ul" map)

362 (yahtml-define-begend-key "bo" "ol" map)

363 (yahtml-define-begend-key "b1" "h1" map)

364 (yahtml-define-begend-key "b2" "h2" map)

365 (yahtml-define-begend-key "b3" "h3" map)

366 (yahtml-define-begend-key "ba" "a" map)

367 (yahtml-define-begend-key "bf" "form" map)

368 (yahtml-define-begend-key "bs" "select" map)

369 (yahtml-define-begend-key "bv" "div" map)

370 (yahtml-define-begend-key "bS" "span" map)

371 (yahtml-define-begend-key "bp" "pre" map)

372 (YaTeX-define-key "b " 'yahtml-insert-begend map)

373 (YaTeX-define-key "B " 'yahtml-insert-begend-region map))

374 (YaTeX-define-key "e" 'YaTeX-end-environment map)

375 (YaTeX-define-key ">" 'yahtml-comment-region map)

376 (YaTeX-define-key "<" 'yahtml-uncomment-region map)

377 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)

378 (YaTeX-define-key "k" 'yahtml-kill-* map)

379 (YaTeX-define-key "c" 'yahtml-change-* map)

380 (YaTeX-define-key "t" 'yahtml-browse-menu map)

381 (YaTeX-define-key "a" 'yahtml-complete-mark map)

382 (YaTeX-define-key "'" 'yahtml-prev-error map)

383 (YaTeX-define-key ";" 'yahtml-translate-region map)

384 (YaTeX-define-key ":" 'yahtml-translate-reverse-region map)

385 (YaTeX-define-key "#" 'yahtml-escape-chars-region map)

386 (YaTeX-define-key "}" 'yahtml-td-region map)

387 (YaTeX-define-key "]" 'yahtml-tr-region map)

388 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)

389 (YaTeX-define-key "\e" 'yahtml-quit map))

390 (substitute-all-key-definition

391 'fill-paragraph 'yahtml-fill-paragraph yahtml-mode-map)

392 (substitute-all-key-definition

393 'kill-buffer 'YaTeX-kill-buffer yahtml-mode-map))

394

395 (if yahtml-lint-buffer-map nil

396 (setq yahtml-lint-buffer-map (make-keymap))

397 (define-key yahtml-lint-buffer-map " " 'yahtml-jump-to-error-line))

398

399

400 (defvar yahtml-paragraph-start

401 (concat

402 "^$\\|<!--\\|^[ \t]*</?\$h[1-6]\\|p\\|d[ldt]\\|[bhtd][rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\$\\b")

403 "*Regexp of html paragraph separater")

404 (defvar yahtml-paragraph-separate

405 (concat

406 "^$\\|<!--\\|^[ \t]*</?\$h[1-6]\\|p\\|[bhtd][ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\|!--\$\\b")

407 "*Regexp of html paragraph separater")

408 (defvar yahtml-syntax-table nil

409 "*Syntax table for yahtml-mode")

410

411 (if yahtml-syntax-table nil

412 (setq yahtml-syntax-table

413 (make-syntax-table (standard-syntax-table)))

414 (modify-syntax-entry ?\< "(>" yahtml-syntax-table)

415 (modify-syntax-entry ?\> ")<" yahtml-syntax-table)

416 (modify-syntax-entry ?\n " " yahtml-syntax-table))

417

418 (defvar yahtml-command-regexp "[A-Za-z0-9]+"

419 "Regexp of constituent of html commands.")

420

421 ;;; Completion tables for `form'

422 (defvar yahtml-form-table

423 '(("img") ("input") ("link") ("meta")))

424 (defvar yahtml-user-form-table nil)

425 (defvar yahtml-tmp-form-table nil)

426 (defvar yahtml-last-form "img")

427

428 (defvar yahtml-env-table

429 '(("html") ("head") ("title") ("body") ("dl") ("ul") ("ol") ("pre")

430 ("a") ("form") ("select") ("center") ("textarea") ("blockquote")

431 ("OrderedList" . "ol")

432 ("UnorderedList" . "ul")

433 ("DefinitionList" . "dl")

434 ("Preformatted" . "pre")

435 ("table") ("thead") ("tbody") ("tfoot") ("tr") ("th") ("td")

436 ("address") ("button")

437 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6")

438 ;; ("p") ;This makes indentation screwed up!

439 ("style") ("script") ("noscript") ("div") ("object") ("ins") ("del")

440 ))

441

442 (if yahtml-html4-strict

443 (setq yahtml-env-table

444 (delete (assoc "center" yahtml-env-table) yahtml-env-table)))

445

446 ;(defvar yahtml-itemizing-regexp

447 ; "\$ul\\|ol\\|dl\$"

448 ; "Regexp of itemizing forms")

449

450 (defvar yahtml-user-env-table nil)

451 (defvar yahtml-tmp-env-table nil)

452

453 ;;; Completion tables for typeface designator

454 (and yahtml-always-/p

455 (or (assoc "p" yahtml-env-table)

456 (setq yahtml-env-table (cons '("p") yahtml-env-table))))

457 (and yahtml-always-/li

458 (or (assoc "li" yahtml-env-table)

459 (setq yahtml-env-table (cons '("li") yahtml-env-table))))

460 (and yahtml-always-/dt

461 (or (assoc "dt" yahtml-env-table)

462 (setq yahtml-env-table (cons '("dt") yahtml-env-table))))

463 (and yahtml-always-/dd

464 (or (assoc "dd" yahtml-env-table)

465 (setq yahtml-env-table (cons '("dd") yahtml-env-table))))

466

467 (defvar yahtml-typeface-table

468 (append

469 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("caption")

470 ("strong") ("var") ("b") ("i") ("tt") ("big") ("small")

471 ("sup") ("sub") ("span") ("abbr"))

472 (if (not yahtml-html4-strict)

473 '(("strike") ("s") ("u") ("font")))

474 yahtml-env-table)

475 "Default completion table of typeface designator")

476 (defvar yahtml-user-typeface-table nil)

477 (defvar yahtml-tmp-typeface-table nil)

478 (defvar yahtml-last-typeface-cmd "a")

479

480 (defvar yahtml-single-cmd-table

481 '(("hr") ("br") ("option")

482 ("HorizontalRule" . "hr")

483 ("BreakLine" . "br")

484 ("exec" . "!--#exec")

485 ("!--#exec")

486 ("include" . "!--#include")

487 ("!--#include")

488 ;; ("Item" . "li")

489 ;; ("DefineTerm" . "dt")

490 ;; ("Description" . "dd")

491 ;; ("dd") ("dt") ("li")

492 )

493 "Default completion table of HTML single command.")

494 (defvar yahtml-user-single-cmd-table nil)

495 (defvar yahtml-tmp-single-cmd-table nil)

496 (defvar yahtml-last-single-cmd nil)

497

498 (defvar yahtml-current-completion-type nil

499 "Has current completion type. This may be used in yahtml addin functions.")

500

501 (defvar yahtml-struct-name-regexp

502 (concat

503 "\\<\\("

504 ;(mapconcat 'car yahtml-typeface-table "\\|")

505 (mapconcat 'car yahtml-env-table "\\|")

506 "\\)\\b")

507 "Regexp of structure beginning.")

508

509 (defvar yahtml-closable-regexp

510 (concat

511 "\\<\\("

512 (mapconcat 'car yahtml-typeface-table "\\|")

513 (mapconcat 'car yahtml-env-table "\\|")

514 "\\)\\b")

515 "Regexp of any closable elemnts.")

516

517 (defvar yahtml-indent-listing-constant t

518 "*Nil means indentation for listing obeys the column of `>'.

519 T for static indentation depth")

520

521 (or (assoc "p" yahtml-env-table)

522 (setq yahtml-env-table (cons '("p") yahtml-env-table)))

523

524

525 (defun yahtml-get-user-httpconf-entry (regexp)

526 (cond

527 ((and (eq yahtml-server-type 'apache) ;;check .htaccess

528 buffer-file-name)

529 (let ((dir default-directory)

530 charset af ext (ldir "")

531 line

532 (case-fold-search t)

533 (uid (car (cdr (cdr (file-attributes "."))))))

534 (if (string-match "^[A-Z]:" dir)

535 (setq dir (substring dir 2))) ;remove drive letter

536 (while (and dir

537 (not (string= dir ldir))

538 (equal uid (car (cdr (cdr (file-attributes dir))))))

539 (setq af (expand-file-name yahtml-apache-access-file dir))

540 (if (file-exists-p af)

541 (save-excursion

542 (set-buffer (find-file-noselect af))

543 (save-excursion

544 (goto-char (point-min))

545 (if (re-search-forward regexp nil t)

546 (setq line (buffer-substring

547 (point-beginning-of-line)

548 (point-end-of-line))

549 dir nil)))

550 (kill-buffer (current-buffer))))

551 (if dir

552 (setq ldir dir

553 dir (substring dir 0 (string-match "/$" dir))

554 dir (file-name-directory dir))))

555 line))

556 (t nil)))

557

558 (defun yahtml-dir-default-charset ()

559 (let*((fn (file-name-nondirectory (or buffer-file-name "")))

560 (ext (substring fn (or (string-match "\\.[a-z0-9]+$" fn) 0)))

561 (ptn (format "^\\s *AddType.*charset=\$.*\$\\%s$" ext))

562 (case-fold-search t)

563 line

564 charset)

565 (if (setq line (yahtml-get-user-httpconf-entry ptn))

566 (progn

567 (string-match ptn line)

568 (setq charset

569 (substring line (match-beginning 1) (match-end 1)))

570 (cond

571 ((string-match "iso-2022-jp" charset)

572 (setq charset 2))

573 ((string-match "euc-jp" charset)

574 (setq charset 3))

575 ((string-match "shift_jis" charset)

576 (setq charset 1))

577 ((string-match "utf-8" charset)

578 (setq charset 4))

579 (t (setq charset nil)))

580 (setq dir "")))

581 (if (featurep 'mule)

582 (setq charset (cdr (assq charset YaTeX-kanji-code-alist))))

583 charset))

584

585 (defun yahtml-get-directory-index ()

586 (let ((line (yahtml-get-user-httpconf-entry "^\\s *DirectoryIndex"))

587 x index-list)

588 ;;s/\\s *$//;

589 (if line

590 (progn

591 (if (string-match "DirectoryIndex\\s +\$.*\$\\s *$" line)

592 (setq line (substring line (match-beginning 1) (match-end 1))))

593 (while (string< "" line)

594 (if (setq x (string-match "\$\\s +\$" line))

595 (setq index-list (cons (substring line 0 x) index-list)

596 line (substring line (match-end 1)))

597 (setq index-list (cons line index-list)

598 line "")))

599 (or (nreverse index-list)

600 (if (listp yahtml-directory-index)

601 yahtml-directory-index

602 (list yahtml-directory-index)))))))

603

604 (defvar yahtml-mode-old-mode nil)

605 (defun yahtml-mode ()

606 (interactive)

607 (let ((old-mm major-mode)) ;Emacs21.0.95 resets major-mode

608 (kill-all-local-variables) ;with kill-all-local-variables

609 (if (not (eq 'yahtml-mode old-mm))

610 (set (make-local-variable 'yahtml-mode-old-mode) old-mm)))

611 (let ((coding (or (yahtml-dir-default-charset) yahtml-kanji-code)))

612 (cond

613 ((null coding) nil)

614 ((and YaTeX-emacs-20 (boundp 'buffer-file-coding-system))

615 (setq buffer-file-coding-system

616 (or (and (fboundp 'set-auto-coding) buffer-file-name

617 (save-excursion

618 (goto-char (point-min))

619 (set-auto-coding buffer-file-name (buffer-size))))

620 coding)))

621 ((featurep 'mule)

622 (set-file-coding-system coding))

623 ((boundp 'NEMACS)

624 (make-local-variable 'kanji-fileio-code)

625 (setq kanji-fileio-code coding))))

626 (setq major-mode 'yahtml-mode

627 mode-name "yahtml"

628 YaTeX-current-file-name (file-name-nondirectory

629 (or (buffer-file-name) ""))

630 local-abbrev-table yahtml-mode-abbrev-table)

631 (mapcar

632 (function (lambda (x)

633 (make-local-variable (car x))

634 (set (car x) (if (and (symbolp (cdr x))

635 (boundp (cdr x)))

636 (symbol-value (cdr x))

637 (cdr x)))))

638 '((YaTeX-ec . "")

639 (YaTeX-struct-begin . "<%1%2")

640 (YaTeX-struct-end . "</%1>")

641 (YaTeX-struct-name-regexp . yahtml-closable-regexp)

642 (YaTeX-comment-prefix . "<!--[^#]")

643 (YaTeX-coding-system . yahtml-kanji-code) ;necessary?

644 (YaTeX-typesetting-mode-map . yahtml-lint-buffer-map)

645 (fill-prefix . yahtml-fill-prefix) (fill-column . yahtml-fill-column)

646 (paragraph-start . yahtml-paragraph-start)

647 (paragraph-separate . yahtml-paragraph-separate)

648 (comment-start . "")

649 (comment-start-skip . comment-start)

650 (indent-line-function . yahtml-indent-line)))

651

652 (if yahtml-use-font-lock

653 (progn

654 (yahtml-font-lock-set-default-keywords)

655 (or (featurep 'xemacs)

656 (progn

657 (set (make-local-variable 'font-lock-defaults)

658 '(yahtml-font-lock-keywords nil t))

659 ;;(font-lock-mode -1)

660 (font-lock-mode 1) ;;Why should I fontify again???

661 ;; in yatex-mode, there's no need to refontify...

662 (font-lock-fontify-buffer)))))

663 (set-syntax-table yahtml-syntax-table)

664 (use-local-map yahtml-mode-map)

665 (YaTeX-read-user-completion-table)

666 (yahtml-css-scan-styles)

667 (turn-on-auto-fill) ;Sorry, this is prerequisite

668 (and (= 0 (buffer-size)) (file-exists-p yahtml-template-file)

669 (y-or-n-p (format "Insert %s?" yahtml-template-file))

670 (insert-file-contents (expand-file-name yahtml-template-file)))

671 (run-hooks 'text-mode-hook 'yahtml-mode-hook)

672

673 ;; This warning should be removed after a while(2000/12/2)

674 (let ((fld (or (and (local-variable-p 'font-lock-defaults (current-buffer))

675 font-lock-defaults)

676 (get 'yahtml-mode 'font-lock-defaults))))

677 (and fld (not (memq 'yahtml-font-lock-keywords fld))

678 (YaTeX-warning-font-lock "yahtml"))))

679

680 (defun yahtml-version ()

681 "Return string of the version of running yahtml."

682 (interactive)

683 (message

684 (concat "Yet Another HTML-mode "

685 (if YaTeX-japan "「HTML屋」" "`yahtml'")

686 " Revision "

687 yahtml-revision-number)))

688

689 (defun yahtml-quit ()

690 (interactive)

691 (and yahtml-mode-old-mode

692 (fboundp yahtml-mode-old-mode)

693 (funcall yahtml-mode-old-mode)))

694

695 (defun yahtml-define-menu (keymap bindlist)

696 (cond

697 ((featurep 'xemacs)

698 (let ((name (keymap-name (symbol-value keymap))))

699 (set keymap nil)

700 (mapcar

701 (function

702 (lambda (bind)

703 (setq bind (cdr bind))

704 (if (eq (car (cdr bind)) 'lambda)

705 (setcar (cdr bind) 'progn))

706 (if (stringp (car (cdr bind)))

707 (set keymap (cons (cdr bind) (symbol-value keymap)))

708 (set keymap (cons (vector (car bind) (cdr bind) t)

709 (symbol-value keymap))))))

710 bindlist)

711 (set keymap (cons name (symbol-value keymap)))))

712 (t

713 (mapcar

714 (function

715 (lambda (bind)

716 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))

717 bindlist))))

718

719 (defvar yahtml-menu-map nil "Menu map of yahtml")

720 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")

721 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")

722 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")

723 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")

724

725 ;;; Variables for mosaic url history

726 (defvar yahtml-urls nil "Alist of global history")

727 (defvar yahtml-urls-private nil)

728 (defvar yahtml-urls-local nil)

729

730 (cond

731 ((and YaTeX-emacs-19 (null yahtml-menu-map))

732 (setq yahtml-menu-map (make-sparse-keymap "yahtml"))

733 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))

734 (YaTeX-define-menu

735 'yahtml-menu-map-sectioning

736 (nreverse

737 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))

738 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))

739 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))

740 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))

741 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))

742 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))

743 )))

744 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))

745 (YaTeX-define-menu

746 'yahtml-menu-map-logical

747 (nreverse

748 '((em "Embolden" .

749 (lambda () (interactive) (yahtml-insert-tag nil "EM")))

750 (dfn "Define a word" .

751 (lambda () (interactive) (yahtml-insert-tag nil "DFN")))

752 (cite "Citation" .

753 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))

754 (code "Code" .

755 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))

756 (kbd "Keyboard" .

757 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))

758 (samp "Sample display" .

759 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))

760 (strong "Strong" .

761 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))

762 (VAR "Variable notation" .

763 (lambda () (interactive) (yahtml-insert-tag nil "var"))))))

764 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))

765 (YaTeX-define-menu

766 'yahtml-menu-map-typeface

767 (nreverse

768 '((b "Bold" .

769 (lambda () (interactive) (yahtml-insert-tag nil "b")))

770 (i "Italic" .

771 (lambda () (interactive) (yahtml-insert-tag nil "i")))

772 (tt "Typewriter" .

773 (lambda () (interactive) (yahtml-insert-tag nil "tt")))

774 (u "Underlined" .

775 (lambda () (interactive) (yahtml-insert-tag nil "u"))))))

776 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))

777 (YaTeX-define-menu

778 'yahtml-menu-map-listing

779 (nreverse

780 '((ul "Unordered" .

781 (lambda () (interactive) (yahtml-insert-begend nil "ul")))

782 (ol "Ordered" .

783 (lambda () (interactive) (yahtml-insert-begend nil "ol")))

784 (dl "Definition" .

785 (lambda () (interactive) (yahtml-insert-begend nil "dl"))))))

786 (setq yahtml-menu-map-item (make-sparse-keymap "item"))

787 (YaTeX-define-menu

788 'yahtml-menu-map-item

789 (nreverse

790 '((li "Simple item" .

791 (lambda () (interactive) (yahtml-insert-single "li")))

792 (dt "Define term" .

793 (lambda () (interactive) (yahtml-insert-single "dt")))

794 (dd "Description of term" .

795 (lambda () (interactive) (yahtml-insert-single "dd"))))))

796 (define-key yahtml-mode-map [menu-bar yahtml]

797 (cons "yahtml" yahtml-menu-map))

798 (YaTeX-define-menu

799 'yahtml-menu-map

800 (nreverse

801 (list

802 (cons (list 'sect "Sectioning")

803 (cons "sectioning" yahtml-menu-map-sectioning))

804 (cons (list 'list "Listing")

805 (cons "Listing" yahtml-menu-map-listing))

806 (cons (list 'item "Item")

807 (cons "Itemizing" yahtml-menu-map-item));;;

808 (cons (list 'logi "Logical tags")

809 (cons "logical" yahtml-menu-map-logical))

810 (cons (list 'type "Typeface tags")

811 (cons "typeface" yahtml-menu-map-typeface)))))

812 (if (featurep 'xemacs)

813 (add-hook 'yahtml-mode-hook

814 '(lambda ()

815 (or (assoc "yahtml" current-menubar)

816 (progn

817 (set-buffer-menubar (copy-sequence current-menubar))

818 (add-submenu nil yahtml-menu-map))))))))

819

820 ;;; ----------- Completion ----------

821 (defvar yahtml-last-begend "html")

822 (defun yahtml-insert-begend (&optional region env)

823 "Insert <cmd> ... </cmd>."

824 (interactive "P")

825 (setq yahtml-current-completion-type 'multiline)

826 (let*((completion-ignore-case t)

827 (cmd

828 (or env

829 (YaTeX-cplread-with-learning

830 (format "Environment(default %s): " yahtml-last-begend)

831 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))

832 (bolp (save-excursion

833 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))

834 (cc (current-column)))

835 (if (string< "" cmd) (setq yahtml-last-begend cmd))

836 (setq yahtml-last-begend

837 (or (cdr (assoc yahtml-last-begend yahtml-env-table))

838 yahtml-last-begend))

839 (setq cmd yahtml-last-begend)

840 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase) cmd))

841 (if region

842 ;; We want to keep region effective for new tagged environment

843 ;; to enable continuous regioning by another environment

844 (let ((beg (region-beginning))

845 (end (region-end))

846 (addin (yahtml-addin cmd)))

847 (save-excursion

848 (goto-char end)

849 (insert-before-markers (format "</%s>%s" cmd (if bolp "\n" "")))

850 (goto-char beg)

851 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" "")))))

852 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))

853 (save-excursion

854 (insert "\n")

855 (indent-to-column cc)

856 (insert (format "</%s>" cmd)))

857 (if (string-match "^a\\|p$" cmd) ;aとp決め打ちってのが美しくない…

858 (newline)

859 (yahtml-intelligent-newline nil))

860 (yahtml-indent-line))))

861

862 (defun yahtml-insert-begend-region ()

863 "Call yahtml-insert-begend in the region mode."

864 (interactive)

865 (yahtml-insert-begend t))

866

867

868 (defun yahtml-insert-form (&optional form)

869 "Insert <FORM option=\"argument\">."

870 (interactive)

871 (setq yahtml-current-completion-type 'single)

872 (or form

873 (let ((completion-ignore-case t))

874 (setq form

875 (YaTeX-cplread-with-learning

876 (format "Form(default %s): " yahtml-last-form)

877 'yahtml-form-table 'yahtml-user-form-table

878 'yahtml-tmp-form-table))))

879 (let ((p (point)) q)

880 (if (string= form "") (setq form yahtml-last-form))

881 (setq yahtml-last-form form)

882 (if yahtml-prefer-upcases (setq form (upcase form)))

883 (insert (format "<%s%s>" form (yahtml-addin form)))

884 ;;(indent-relative-maybe)

885 (if (cdr (assoc form yahtml-form-table))

886 (save-excursion (insert (format "</%s>" form))))

887 (if (search-backward "\"\"" p t) (forward-char 1))))

888

889 (defun yahtml-read-css (alist)

890 (let ((completion-ignore-case t) (delim " ")

891 (minibuffer-completion-table alist))

892 (read-from-minibuffer

893 (substitute-command-keys

894 (if YaTeX-japan

895 "クラス(複数指定は\\[quoted-insert] SPCで区切る): "

896 "class(or class list delimited by \\[quoted-insert] SPC): "))

897 nil YaTeX-minibuffer-completion-map nil)))

898

899 (defvar yahtml-newpage-command "newpage.rb"

900 "*Command name to create new HTML file referring to index.html.

901 This command should create new HTML file named argument 1 and

902 output string like `<a href=\"newfile.html\">anchor tag</a>'.

903 This program should take -o option to overwrite existing HTML file.")

904 (defun yahtml-newpage (file ov)

905 "Create newpage via newpage script"

906 (interactive

907 (list

908 (let (insert-default-directory)

909 (read-file-name "New webpage file name: " ""))

910 current-prefix-arg))

911 (if (and (file-exists-p file) (not ov))

912 (error "%s already exists. Call this with universal argument to force overwrite." file))

913 (insert (substring

914 (YaTeX-command-to-string

915 (concat yahtml-newpage-command " " (if ov "-o ") file))

916 0 -1)))

917

918 ;;; ---------- Add-in ----------

919 (defun yahtml-addin (form)

920 "Check add-in function's existence and call it if exists."

921 (let ((addin (concat "yahtml:" (downcase form))) s a)

922 (concat

923 (and (setq a (yahtml-css-get-element-completion-alist form))

924 (not (equal last-command-char ?\C-j))

925 (memq yahtml-current-completion-type '(multiline inline))

926 (not (string-match "#" form))

927 (yahtml-make-optional-argument ;should be made generic?

928 "class" (yahtml-read-css a)))

929 (if (and (intern-soft addin) (fboundp (intern-soft addin))

930 (stringp (setq s (funcall (intern addin))))

931 (string< "" s))

932 (if (eq (aref s 0) ? ) s (concat " " s))

933 ""))))

934

935 (defvar yahtml-completing-buffer nil)

936 (defun yahtml-collect-labels (&optional file)

937 "Collect current buffers label (<?? name=...>).

938 If optional argument FILE is specified collect labels in FILE."

939 (let (list end)

940 (save-excursion

941 (set-buffer yahtml-completing-buffer)

942 (if file (let (hilit-auto-highlight)

943 (set-buffer (find-file-noselect file))))

944 (save-excursion

945 (goto-char (point-min))

946 (while ;(re-search-forward "<\\w+\\b" nil t)

947 (re-search-forward "\$name\\|id\$\\s *=" nil t)

948 ;(setq bound (match-end 0))

949 ;(search-forward ">" nil t)

950 (setq end (match-end 0))

951 (if (and ;(re-search-backward "\$name\\|id\$\\s *=" bound t)

952 (yahtml-on-assignment-p)

953 (progn

954 (goto-char end)

955 (skip-chars-forward " \t\n")

956 (looking-at "\"?#?\$[^\">]+\$\"?\\b")))

957 (setq list (cons

958 (list (concat "#" (YaTeX-match-string 1)))

959 list))))

960 list))))

961

962 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")

963 (if yahtml-url-completion-map nil

964 (setq yahtml-url-completion-map

965 (copy-keymap minibuffer-local-completion-map))

966 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)

967 (define-key yahtml-url-completion-map " " 'yahtml-complete-url))

968

969 (defun yahtml-complete-url ()

970 "Complete external URL from history or local file name."

971 (interactive)

972 (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels

973 (lim (YaTeX-minibuffer-begin))

974 (min (if (fboundp 'field-beginning) (field-beginning) (point-min))))

975 (setq initial (YaTeX-minibuffer-string))

976 (cond

977 ((string-match "^http:" initial)

978 (setq cmpl (try-completion initial yahtml-urls)

979 listfunc (list 'lambda nil

980 (list 'all-completions initial 'yahtml-urls))

981 beg min))

982 ((setq beg (string-match "#" initial))

983 (or (equal beg 0) ;begin with #

984 (progn

985 (setq path (substring initial 0 beg))

986 (if (string-match "^/" path)

987 (setq path (yahtml-url-to-path path)))))

988 (setq initial (substring initial beg))

989 (setq labels (yahtml-collect-labels path)

990 cmpl (try-completion initial labels)

991 listfunc (list 'lambda ()

992 (list 'all-completions

993 initial (list 'quote labels)))

994 beg (+ min beg)))

995 (t

996 (setq path (if (string-match "^/" initial)

997 (or (yahtml-url-to-path initial) initial)

998 initial))

999 (setq dir (or (file-name-directory path) ".")

1000 file (file-name-nondirectory path)

1001 initial file

1002 cmpl (file-name-completion file dir)

1003 listfunc (list 'lambda nil

1004 (list 'file-name-all-completions

1005 file dir))

1006 beg (save-excursion (skip-chars-backward "^/" lim) (point)))))

1007 (cond

1008 ((stringp cmpl)

1009 (if (string= initial cmpl)

1010 (with-output-to-temp-buffer "*Completions*"

1011 (princ "Possible completinos are:\n")

1012 (princ

1013 (mapconcat '(lambda (x) x) (funcall listfunc) "\n")))

1014 (delete-region (point) beg)

1015 (insert cmpl)))

1016 ((null cmpl)

1017 (ding))

1018 ((eq t cmpl)

1019 (save-excursion

1020 (unwind-protect

1021 (progn

1022 (goto-char p)

1023 (insert " [Sole completion]"))

1024 (delete-region p (point-max))))))))

1025

1026 ;

1027 ; Subject: [yatex:02849] Re: [yahtml] tilda in href tag

1028 ; From: Masayasu Ishikawa <mimasa<at>sfc.keio.ac.jp>

1029 ; To: yatex<at>arcadia.jaist.ac.jp

1030 ; Date: Mon, 31 May 1999 21:09:31 +0900

1031 ; RFC 2396 の "2.4.3. Excluded US-ASCII Characters" によると、以下の文字

1032 ; は必ずエスケープしないといけません。

1033 ;

1034 ; control = <US-ASCII coded characters 00-1F and 7F hexadecimal>

1035 ; space = <US-ASCII coded character 20 hexadecimal>

1036 ; delims = "<" | ">" | "#" | "%" | <">

1037 ; unwise = "{" | "}" | "|" | "\" | "^" | "[" | "]" | "`"

1038 (defvar yahtml-unsafe-chars-regexp

1039 "[][\x0- \x7f <>%\"{}|\\^`]" ;#は除去する

1040 "Characters regexp which must be escaped in URI.")

1041 ;

1042 ; また、以下の文字は予約された用法以外に用いる場合にはエスケープしないと

1043 ; いけないことになっています。

1044 ;

1045 ; reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" |

1046 ; "$" | ","

1047 (defvar yahtml-unreserved-chars-regexp

1048 "[;/?:@&=+$,]"

1049 "Characters regexp which should be escaped in URI on certain conditions.

1050 Not used yet.")

1051

1052 (defun yahtml-escape-chars-string (str)

1053 "Translate reserved chars to URL encoded string."

1054 (let ((p 0) (target "")

1055 (ask (eq yahtml-escape-chars 'ask)))

1056 (cond

1057 ((null yahtml-escape-chars) str)

1058 (t

1059 (while (and (string< "" str)

1060 (setq p (string-match yahtml-unsafe-chars-regexp str)))

1061 (if (and ask (y-or-n-p (format "Escape char [%c] of `%s'"

1062 (aref str p) (substring str 0 (1+ p)))))

1063 (setq target (concat target

1064 (substring str 0 p)

1065 (format "%%%x" (aref str p))))

1066 (setq target (concat target (substring str 0 (1+ p)))))

1067 (setq str (substring str (1+ p))))

1068 (concat target str)))))

1069

1070 (defun yahtml-unescape-string (str)

1071 "Untranslate reserved URL-encoded string."

1072 (let ((p 0) c (target "") (md (match-data)) (case-fold-search nil))

1073 (unwind-protect

1074 (progn

1075 (while (string-match "%\$[0-9a-f][0-9a-f]\$" str p)

1076 (setq target (concat target

1077 (substring str p (1- (match-beginning 1))))

1078 p (match-end 0)

1079 c (YaTeX-hex (substring

1080 str (match-beginning 1) (match-end 1)))

1081 target (concat target (format "%c" c))))

1082 (concat target (substring str p)))

1083 (store-match-data md))))

1084

1085 (defun yahtml-escape-chars-region (beg end)

1086 "Translate reserved chars to encoded string in the region."

1087 (interactive "r")

1088 (save-excursion

1089 (let ((e (set-marker (make-marker) end)) c m yes)

1090 (goto-char beg)

1091 (while (and (< (point) e)

1092 (re-search-forward

1093 (concat yahtml-unsafe-chars-regexp "\\|"

1094 yahtml-unreserved-chars-regexp) e t))

1095 (sit-for 0)

1096 ; (setq m (buffer-modified-p)

1097 ; c (char-after (1- (point))))

1098 ; (save-excursion (backward-char 1) (insert " ==>"))

1099 ; (unwind-protect

1100 ; (setq yes (y-or-n-p (format "Replace: [%c]" c)))

1101 ; (save-excursion

1102 ; (backward-char 1)

1103 ; (delete-backward-char 4))

1104 ; (set-buffer-modified-p m))

1105 (message "Replace: [%c] (y or n):" (setq c (char-after (1- (point)))))

1106 (if (memq (read-char) '(?y ?Y))

1107 (progn

1108 (delete-region (match-beginning 0) (match-end 0))

1109 (insert (format "%%%x" c)))))

1110 (set-marker e nil))))

1111 ;; ab%defgls/.|

1112

1113 (defun yahtml:a ()

1114 "Add-in function for <a>"

1115 (let ((href ""))

1116 (setq yahtml-completing-buffer (current-buffer)

1117 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

1118 href (yahtml-escape-chars-string

1119 (read-from-minibuffer "href: " "" yahtml-url-completion-map)))

1120 (prog1

1121 (concat (yahtml-make-optional-argument

1122 "href" href)

1123 (yahtml-make-optional-argument

1124 "name" (read-string "name: ")))

1125 (if (and (string-match "^http://" href)

1126 (null (assoc href yahtml-urls-private))

1127 (null (assoc href yahtml-urls-local)))

1128 (YaTeX-update-table

1129 (list href)

1130 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1131

1132 (defvar yahtml-parameters-completion-alist

1133 '(("align" ("top") ("middle") ("bottom") ("left") ("right") ("center"))

1134 ("clear" ("left") ("right") ("center") ("all") ("none"))

1135 ("lang" ("ja") ("en") ("kr") ("ch") ("fr"))

1136 ("src" . file) ("file" . file)

1137 ("background" . file)

1138 ("class file name" . file) ("data" . file)

1139 ("method" ("POST") ("GET"))

1140 ("rev" . yahtml-link-types-alist)

1141 ("rel" . yahtml-link-types-alist)

1142 ("type" . yahtml-content-types-alist)

1143 ("codetype" . yahtml-content-types-alist)

1144 ("http-equiv" ("Refresh"))))

1145

1146 (defvar yahtml-link-types-alist

1147 '(("alternate") ("stylesheet") ("start") ("next") ("prev")

1148 ("contents") ("index") ("glossary") ("chapter") ("section")

1149 ("subsection") ("appendix") ("help") ("bookmark")))

1150

1151 (defvar yahtml-content-types-alist

1152 '(("text/css") ("text/html") ("text/plain") ("text/richtext")

1153 ("text/sgml") ("text/xml")

1154 ("text/javascript") ("text/tcl") ("text/vbscript")

1155 ("application/octet-stream") ("application/postscript") ("application/pdf")

1156 ("application/java")

1157 ("image/jpeg") ("image/gif") ("image/tiff") ("image/png") ("video/mpeg"))

1158 "Alist of content-types")

1159

1160 (defun yahtml-read-parameter (par &optional default alist)

1161 (let* ((alist

1162 (cdr-safe (assoc (downcase par)

1163 (or alist yahtml-parameters-completion-alist))))

1164 (prompt (concat par ": "))

1165 v)

1166 (cond

1167 ((eq alist 'file)

1168 (let ((insert-default-directory))

1169 (read-file-name prompt "" default nil "")))

1170 ((eq alist 'command)

1171 (if (fboundp 'read-shell-command)

1172 (read-shell-command prompt)

1173 (read-string prompt)))

1174 ((and alist (symbolp alist))

1175 (completing-read prompt (symbol-value alist) nil nil default))

1176 (alist

1177 (completing-read prompt alist nil nil default))

1178 (t

1179 (read-string prompt default)))))

1180

1181 (defun yahtml-make-optional-argument (opt arg)

1182 "Make optional argument string."

1183 (if (or (null arg) (string= "" arg))

1184 ""

1185 (concat " "

1186 (if yahtml-prefer-upcase-attributes (upcase opt) (downcase opt))

1187 "=\"" arg "\"")))

1188

1189 (defun yahtml:html ()

1190 "Add-in for <html>"

1191 (setq yahtml-last-begend "head" yahtml-last-typeface-cmd "head")

1192 (yahtml-make-optional-argument

1193 "lang" (yahtml-read-parameter "lang" (if YaTeX-japan "ja"))))

1194

1195 (defun yahtml:head ()

1196 "Add-in for <head>"

1197 (setq yahtml-last-begend "title" yahtml-last-typeface-cmd "title")

1198 "")

1199

1200 (defun yahtml:body ()

1201 "Add-in function for <body>"

1202 (cond

1203 (yahtml-html4-strict nil)

1204 (t

1205 (let ((b (read-string "bgcolor="))

1206 (bg (yahtml-read-parameter "background" ""))

1207 (x (read-string "text color="))

1208 (l (read-string "link color="))

1209 (v (read-string "vlink color=")))

1210 (concat

1211 (yahtml-make-optional-argument "bgcolor" b)

1212 (yahtml-make-optional-argument "background" bg)

1213 (yahtml-make-optional-argument "text" x)

1214 (yahtml-make-optional-argument "link" l)

1215 (yahtml-make-optional-argument "vlink" v))))))

1216

1217 (defun yahtml-make-style-parameter (proplist)

1218 "Make CSS property definitions in style attribute."

1219 (mapconcat

1220 '(lambda (x) (if (and (cdr x) (string< "" (cdr x)))

1221 (format "%s: %s;" (car x) (cdr x))))

1222 (delq nil proplist)

1223 " "))

1224

1225 (defun yahtml:img ()

1226 "Add-in function for <img>"

1227 (let ((src (yahtml-read-parameter "src"))

1228 (alg (yahtml-read-parameter "align"))

1229 alt

1230 (brd (read-string "border="))

1231 (l yahtml-prefer-upcase-attributes)

1232 info width height bytes comments)

1233 (and (stringp src) (string< "" src) (file-exists-p src)

1234 (setq info (yahtml-get-image-info src))

1235 (car info)

1236 (setq width (int-to-string (car info))

1237 height (int-to-string (car (cdr info)))

1238 bytes (car (cdr (cdr info)))

1239 comments (nth 4 info)))

1240 (if info

1241 (setq alt

1242 (YaTeX-replace-formats

1243 yahtml:img-default-alt-format

1244 (list (cons "x" width)

1245 (cons "y" height)

1246 (cons "s" (int-to-string bytes))

1247 (cons "f" (file-name-nondirectory src))

1248 (cons "c" (car comments))))))

1249

1250 (setq alt (yahtml-read-parameter "alt" alt))

1251 (setq width (yahtml-read-parameter "width" width)

1252 height (yahtml-read-parameter "height" height))

1253 (concat (if l "SRC" "src") "=\"" src "\""

1254 (yahtml-make-optional-argument "alt" alt)

1255 (yahtml-make-optional-argument "width" width)

1256 (yahtml-make-optional-argument "height" height)

1257 (if yahtml-html4-strict

1258 (yahtml-make-optional-argument

1259 "style"

1260 (if (or brd alg)

1261 (yahtml-make-style-parameter

1262 (list

1263 (if (string< "" alg)

1264 (cons "align" alg))

1265 (if (string< "" brd)

1266 (cons "border"

1267 (format "%dpx" (string-to-int brd))))))))

1268 (concat

1269 (yahtml-make-optional-argument "border" brd)

1270 (yahtml-make-optional-argument "align" alg))))))

1271

1272 (defun yahtml-file-truename (file)

1273 (cond

1274 ((fboundp 'file-truename) (file-truename (expand-file-name file)))

1275 (t (let ((new file))

1276 (while (and (stringp (setq new (nth 0 (file-attributes file))))

1277 (not (equal new file)))

1278 (setq file new))

1279 file))))

1280

1281 (defun yahtml-hex-value (point length &optional little-endian)

1282 "Return the hex value the POINT positions LENGTH byte stream represents.

1283 Optional third argument LITTLE-ENDIAN is self extplanatory."

1284 (setq point (1+ point)) ;translate file offset to Emacs's point value

1285 (let ((mlt 1)

1286 (pos (if little-endian point (+ point length -1)))

1287 (direc (if little-endian 1 -1))

1288 (value 0))

1289 (while (> length 0)

1290 (setq value (+ value (* mlt (char-after pos)))

1291 pos (+ pos direc)

1292 mlt (* mlt 256)

1293 length (1- length)))

1294 value))

1295

1296 (defun yahtml-get-image-info (file)

1297 "Return the information on the image file FILE.

1298 Returns list of '(WIDTH HEIGHT BYTES DEPTH COMMENTLIST)."

1299 (save-excursion

1300 (let*((tmpbuf (get-buffer-create " *imgheader*"))

1301 width height bytes depth comment

1302 (file-coding-system-alist (list (cons "." 'no-conversion))) ;20

1303 (file-coding-system-for-read (and (boundp '*noconv*) *noconv*)) ;19

1304 (coding-system-for-read 'no-conversion)

1305 (seekpoint 1)

1306 c1 c2 c3 c4 beg end

1307 (case-fold-search nil))

1308 (setq bytes (nth 7 (file-attributes (yahtml-file-truename file))))

1309 (set-buffer tmpbuf)

1310 (if (boundp 'mc-flag) (set (make-local-variable 'mc-flag) nil))

1311 (erase-buffer)

1312 (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))

1313 (unwind-protect

1314 (progn

1315 (message "Inspecting image information of %s..." file)

1316 ;; Read 4bytes-more than inspection-bytes in case that

1317 ;; JPEG marker delimiter (4bytes) is on the alignment.

1318 (YaTeX-insert-file-contents

1319 file nil 0 (+ yahtml-image-inspection-bytes 4))

1320 (goto-char (point-min)) ;assertion

1321 (setq c1 (char-after 1) ;cache first 4 bytes

1322 c2 (char-after 2)

1323 c3 (char-after 3)

1324 c4 (char-after 4))

1325 (cond

1326 ((and (eq c1 ?\377) (eq c2 ?\330)) ; 0xff 0xd8

1327 ;;JPEG images need JPEG markers inspection

1328 ;;JPEG markers consist of [ 0xff ID(B) LEN(S) CONTENTS... ]

1329 ;; Warning: here seekpoint is measured by Emacs's point value

1330 ;; while yahtml-hex-vale requires file offset

1331 (setq seekpoint 3) ;where the first JPEG marker exists

1332 (catch 'exit

1333 (while (< seekpoint (- (buffer-size) 4))

1334 (cond

1335 ((not (eq (char-after seekpoint) ?\377))

1336 ;maybe corrupted, exit from loop

1337 (throw 'exit t))

1338 ((memq

1339 (char-after (1+ seekpoint))

1340 '(?\300 ?\301 ?\302 ?\303

1341 ?\305 ?\306 ?\307 ?\311 ?\312 ?\313 ?\315 ?\316 ?\317))

1342 ;;'(192 193 194 195 197 198 199 201 202 203 205 206 207

1343 ;;found!

1344 (setq height (yahtml-hex-value (+ seekpoint 4) 2)

1345 width (yahtml-hex-value (+ seekpoint 6) 2)

1346 depth (yahtml-hex-value (+ seekpoint 3) 1)))

1347 ((eq (char-after (1+ seekpoint)) ?\376) ;0xFE = comment

1348 ;; JPEG comment area

1349 (setq beg (+ seekpoint 2 2)

1350 end (+ seekpoint

1351 (yahtml-hex-value (1+ seekpoint) 2) 2))

1352 (setq comment (cons (buffer-substring beg end) comment)))

1353 (t ;other markers

1354 nil)) ;just skip it

1355 (setq seekpoint (+ seekpoint 2)

1356 seekpoint (+ seekpoint

1357 (yahtml-hex-value (1- seekpoint) 2))))))

1358 ((and (eq c1 ?\211) ;0x89

1359 (eq c2 ?P) (eq c3 ?N) (eq c4 ?G))

1360 ;;PNG Image data X=@0x10(L), Y=@0x14(L), D=@0x18(B)

1361 (setq width (yahtml-hex-value 16 4)

1362 height (yahtml-hex-value 20 4)

1363 depth (yahtml-hex-value 24 1)))

1364 ((looking-at "GIF8")

1365 ;;GIF Image data X=@0x6(leshort), Y=@0x8(leshort)

1366 (setq width (yahtml-hex-value 6 2 t)

1367 height (yahtml-hex-value 8 2 t)))

1368 ((looking-at "BM")

1369 ;;# OS/2, Windoze BMP files

1370 ;;@0x0e = 12 -> OS/2 1.x - X=@0x12(leshort), Y=@0x14(leshort)

1371 ;;@0x0e = 64 -> OS/2 2.x - X=@0x12(leshort), Y=@0x14(leshort)

1372 ;;@0x0e = 40 -> Windows 3.x - X=@0x12(lelong), Y=@0x16(lelong)

1373 (cond

1374 ((eq (yahtml-hex-value 14 2 t) 40)

1375 (setq width (yahtml-hex-value 18 4 t)

1376 height (yahtml-hex-value 22 4 t)))

1377 (t

1378 (setq width (yahtml-hex-value 18 2 t)

1379 height (yahtml-hex-value 20 2 t)))))))

1380 (message "")

1381 (kill-buffer tmpbuf))

1382 (list width height bytes depth (nreverse comment)))))

1383

1384 (defun yahtml:form ()

1385 "Add-in function `form' input format"

1386 (concat

1387 " " (if yahtml-prefer-upcase-attributes "METHOD" "method") "=\""

1388 (completing-read "Method: " '(("POST") ("GET")) nil t)

1389 "\""

1390 (yahtml-make-optional-argument

1391 (if yahtml-prefer-upcase-attributes "ENCTYPE" "enctype")

1392 (completing-read

1393 "Enctype: "

1394 '(("application/x-www-form-urlencoded") ("multipart/form-data"))))

1395 " " (if yahtml-prefer-upcase-attributes "ACTION" "action") "=\""

1396 (read-string "Action: ") "\""))

1397

1398 (defun yahtml:select ()

1399 "Add-in function for `select' input format"

1400 (setq yahtml-last-single-cmd "option")

1401 (concat " " (if yahtml-prefer-upcase-attributes "NAME" "name") "=\""

1402 (read-string "name: ") "\""))

1403

1404 (defun yahtml:ol ()

1405 "Add-in function for <ol>"

1406 (setq yahtml-last-single-cmd "li")

1407 (let ((start (YaTeX-read-string-or-skip "start="))

1408 (type (YaTeX-completing-read-or-skip

1409 "type=" '(("1") ("a") ("A") ("i") ("I")) nil t)))

1410 (concat

1411 (yahtml-make-optional-argument "start" start)

1412 (yahtml-make-optional-argument "type" type))))

1413 (defun yahtml:ul ()

1414 (setq yahtml-last-single-cmd "li") "")

1415 (defun yahtml:dl ()

1416 (setq yahtml-last-single-cmd "dt") "")

1417 (defun yahtml:dt ()

1418 (setq yahtml-last-single-cmd "dd") "")

1419

1420 (defun yahtml:p ()

1421 (if yahtml-html4-strict nil

1422 (let ((alg (yahtml-read-parameter "align")))

1423 (yahtml-make-optional-argument "align" alg))))

1424

1425 (defvar yahtml-input-types

1426 '(("text") ("password") ("checkbox") ("radio") ("submit")

1427 ("reset") ("image") ("hidden") ("file")))

1428

1429 (defun yahtml:input ()

1430 "Add-in function for `input' form"

1431 (let ((size "") name type value checked (maxlength "")

1432 (l yahtml-prefer-upcase-attributes))

1433 (setq name (read-string "name: ")

1434 type (YaTeX-completing-read-or-skip "type (default=text): "

1435 yahtml-input-types nil t)

1436 value (YaTeX-read-string-or-skip "value: "))

1437 (if (string-match "text\\|password\\|^$" type)

1438 (setq size (YaTeX-read-string-or-skip "size: ")

1439 maxlength (YaTeX-read-string-or-skip "maxlength: ")))

1440 (concat

1441 (if l "NAME" "name") "=\"" name "\""

1442 (yahtml-make-optional-argument "type" type)

1443 (yahtml-make-optional-argument "value" value)

1444 (yahtml-make-optional-argument "size" size)

1445 (yahtml-make-optional-argument "maxlength" maxlength))))

1446

1447 (defun yahtml:textarea ()

1448 "Add-in function for `textarea'"

1449 (interactive)

1450 (let (name rows cols)

1451 (setq name (read-string "Name: ")

1452 cols (read-string "Columns: ")

1453 rows (read-string "Rows: "))

1454 (concat

1455 (concat (if yahtml-prefer-upcase-attributes "NAME=" "name=")

1456 "\"" name "\"")

1457 (yahtml-make-optional-argument "cols" cols)

1458 (yahtml-make-optional-argument "rows" rows))))

1459

1460 (defun yahtml:table ()

1461 "Add-in function for `table'"

1462 (let ((b (read-string "border="))

1463 (a (yahtml-read-parameter

1464 "align" nil '(("align" ("right")("center"))))))

1465 (if yahtml-html4-strict

1466 (yahtml-make-optional-argument

1467 "style"

1468 (if (or (string< "" b) (string< "" a))

1469 (yahtml-make-style-parameter

1470 (append

1471 (if (string< "" b)

1472 (list

1473 (cons "border" (format "%dpx solid" (string-to-int b)))

1474 (cons "border-collapse" "collapse")))

1475 (if (string< "" a)

1476 (cond

1477 ((string-match "right" a)

1478 (list (cons "margin-left" "auto")

1479 (cons "margin-right" "0")))

1480 ((string-match "center" a)

1481 (list (cons "margin-left" "auto")

1482 (cons "margin-right" "auto")))))))))

1483 (concat

1484 (yahtml-make-optional-argument "border" b)

1485 (yahtml-make-optional-argument "align" a)))))

1486

1487 ;(fset 'yahtml:caption 'yahtml:p)

1488 (defun yahtml:caption ()

1489 "Add-in function for `caption' in table tag"

1490 (let ((par (yahtml-read-parameter "align")))

1491 (if yahtml-html4-strict

1492 (yahtml-make-optional-argument

1493 "style" (if par (yahtml-make-style-parameter

1494 (list (cons "caption-side" par)))))

1495 (yahtml-make-optional-argument "align" par))))

1496

1497 (defun yahtml:font ()

1498 "Add-in function for `font'"

1499 (concat

1500 (yahtml-make-optional-argument "color" (read-string "color="))

1501 (yahtml-make-optional-argument "size" (read-string "size="))))

1502

1503 (defun yahtml:style ()

1504 "Add-in function for `style'"

1505 (yahtml-make-optional-argument

1506 "type" (read-string "type=" "text/css")))

1507

1508 (defun yahtml:script ()

1509 "Add-in function for `script'"

1510 (concat

1511 (yahtml-make-optional-argument

1512 "type" (yahtml-read-parameter "type" "text/javascript"))

1513 (yahtml-make-optional-argument

1514 "src" (yahtml-read-parameter "src" ""))))

1515

1516 (defun yahtml:tr ()

1517 "Add-in function for `tr'"

1518 (setq ;yahtml-last-begend "td" ;; which do you prefer?

1519 yahtml-last-typeface-cmd "td")

1520 "")

1521

1522 (defun yahtml:link ()

1523 "Add-in function for `link' (まだちょっと良く分かってない)"

1524 (let (rel rev type href)

1525 (setq rel (yahtml-read-parameter "rel"))

1526 (cond

1527 ((equal rel "")

1528 (concat (yahtml-make-optional-argument

1529 "rev" (yahtml-read-parameter "rev"))

1530 (yahtml-make-optional-argument

1531 "href" (yahtml-read-parameter "href")

1532 ;;他に良く使うのって何?

1533 )))

1534 ((string-match "stylesheet" rel)

1535 (concat

1536 (yahtml-make-optional-argument "rel" rel)

1537 (yahtml-make-optional-argument

1538 "type" (yahtml-read-parameter "type" "text/css"))

1539 (progn

1540 (setq href

1541 (read-from-minibuffer "href: " "" yahtml-url-completion-map))

1542 (if (string< "" href)

1543 (progn

1544 (if (and (file-exists-p (yahtml-url-to-path href))

1545 (y-or-n-p "Load css symbols now? "))

1546 (setq yahtml-css-class-alist

1547 (yahtml-css-collect-classes-file

1548 (yahtml-url-to-path href) yahtml-css-class-alist)))

1549 (message "")

1550 (yahtml-make-optional-argument "href" href))))))

1551 (t

1552 (concat

1553 (yahtml-make-optional-argument "rel" rel)

1554 (yahtml-make-optional-argument

1555 "type" (yahtml-read-parameter "type" "text/css"))

1556 (yahtml-make-optional-argument

1557 "href"

1558 (read-from-minibuffer "href: " "" yahtml-url-completion-map)))))))

1559

1560 (defvar yahtml:meta-names

1561 '(("name" ("keywords")("author")("copyright")("date")("GENERATOR"))))

1562

1563 (defun yahtml:meta ()

1564 (let ((name (yahtml-make-optional-argument

1565 "name"

1566 (yahtml-read-parameter "name" nil yahtml:meta-names)))

1567 http-equiv content)

1568 (if (string= "" name)

1569 (if (string-match

1570 "Content-type"

1571 (setq http-equiv (yahtml-make-optional-argument

1572 "http-equiv"

1573 (yahtml-read-parameter "http-equiv" nil))))

1574 (error "It's very bad idea to set Content-type in META. %s"

1575 "See docs/qanda")

1576 (concat http-equiv

1577 (yahtml-make-optional-argument

1578 "content" (yahtml-read-parameter "content"))))

1579 (concat

1580 name

1581 (yahtml-make-optional-argument

1582 "content"

1583 (cond

1584 ((string-match "date" name)

1585 (read-string "Date: " (current-time-string)))

1586 ((string-match "author" name)

1587 (read-string "Author: "

1588 (if (and (user-full-name) (string< "" (user-full-name)))

1589 (user-full-name)

1590 (user-login-name))))

1591 ((string-match "GENERATOR" name)

1592 (setq content (read-string "Generator: " "User-agent: "))

1593 (if (string-match "yahtml" content)

1594 (message "Thank you!"))

1595 content)

1596 (t (read-string (concat name ": ")))))))))

1597

1598 (defun yahtml:br ()

1599 (yahtml-make-optional-argument "clear" (yahtml-read-parameter "clear")))

1600

1601 (defun yahtml:object ()

1602 (let ((codetype (yahtml-read-parameter "codetype" "application/java"))

1603 data classid)

1604 (cond

1605 ((string-match "java" codetype)

1606 (let ((completion-ignored-extensions

1607 ;;any extensions except ".class"

1608 '(".java" ".html" ".htm" ".gif" ".jpg" ".jpeg" ".png")))

1609 (setq classid (concat "java:"

1610 (yahtml-read-parameter "class file name"))))

1611 (concat

1612 (yahtml-make-optional-argument "codetype" codetype)

1613 (yahtml-make-optional-argument "classid" classid)

1614 (yahtml-make-optional-argument

1615 "width" (yahtml-read-parameter "width"))

1616 (yahtml-make-optional-argument

1617 "height" (yahtml-read-parameter "height"))

1618 (yahtml-make-optional-argument

1619 "align" (yahtml-read-parameter "align"))))

1620 (t

1621 ""))))

1622

1623 (defun yahtml:abbr ()

1624 "Add-in function for abbr."

1625 (yahtml-make-optional-argument "title" (yahtml-read-parameter "title")))

1626

1627 (defun yahtml:button ()

1628 (concat

1629 (yahtml-make-optional-argument

1630 "name" (yahtml-read-parameter "name"))

1631 (yahtml-make-optional-argument

1632 "type" (yahtml-read-parameter

1633 "type" "button" '(("submit")("reset")("button"))))

1634 (yahtml-make-optional-argument

1635 "value" (yahtml-read-parameter "value"))))

1636

1637 ;;; ---------- Simple tag ----------

1638 (defun yahtml-insert-tag (region-mode &optional tag)

1639 "Insert <TAG> </TAG> and put cursor inside of them."

1640 (interactive "P")

1641 (setq yahtml-current-completion-type 'inline)

1642 (or tag

1643 (let ((completion-ignore-case t))

1644 (setq tag

1645 (YaTeX-cplread-with-learning

1646 (format "Tag %s(default %s): "

1647 (if region-mode "region: " "") yahtml-last-typeface-cmd)

1648 'yahtml-typeface-table 'yahtml-user-typeface-table

1649 'yahtml-tmp-typeface-table))))

1650 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))

1651 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))

1652 (setq yahtml-last-typeface-cmd tag

1653 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))

1654 (if region-mode

1655 (if (if (string< "19" emacs-version) (mark t) (mark))

1656 (save-excursion

1657 (if (> (point) (mark)) (exchange-point-and-mark))

1658 (insert (format "<%s%s>" tag (yahtml-addin tag)))

1659 (exchange-point-and-mark)

1660 (insert "</" tag ">"))

1661 (message "No mark set now"))

1662 (insert (format "<%s%s>" tag (yahtml-addin tag)))

1663 (save-excursion (insert (format "</%s>" tag)))))

1664

1665 (defun yahtml-insert-tag-region (&optional tag)

1666 "Call yahtml-insert-tag with region mode."

1667 (interactive)

1668 (yahtml-insert-tag t tag))

1669

1670 (defvar yahtml-need-single-closer nil) ;for test

1671 (defun yahtml-insert-single (cmd)

1672 "Insert <CMD>."

1673 (interactive

1674 (list

1675 (let ((completion-ignore-case t))

1676 (YaTeX-cplread-with-learning

1677 (format "Command%s: "

1678 (if yahtml-last-single-cmd

1679 (concat "(default " yahtml-last-single-cmd ")") ""))

1680 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

1681 'yahtml-tmp-single-cmd-table))))

1682 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))

1683 (setq yahtml-last-single-cmd

1684 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))

1685 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)

1686 yahtml-last-single-cmd))

1687 (insert (format "<%s%s%s>"

1688 cmd

1689 (yahtml-addin cmd)

1690 (if (and yahtml-need-single-closer

1691 (assoc cmd '(("br")("hr"))))

1692 " /" "")))

1693 (if (assoc cmd yahtml-env-table)

1694 (save-excursion (insert (format "</%s>" cmd)))))

1695

1696 (defun yahtml-insert-p (&optional arg)

1697 "Convenient function to insert <p></p>"

1698 (interactive "P")

1699 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")

1700 (yahtml-insert-single "p")))

1701

1702 (defun yahtml-insert-amps (arg)

1703 "Insert char-entity references via ampersand"

1704 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/

1705 (interactive "P")

1706 (let*((mess "") c

1707 (list (append yahtml-entity-reference-chars-alist-default

1708 yahtml-entity-reference-chars-alist))

1709 (l list))

1710 (while l

1711 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))

1712 l (cdr l)))

1713 (message "Char-entity reference: %s SPC=& RET=&; Other=&#..;" mess)

1714 (setq c (read-char))

1715 (cond

1716 ((equal c (car-safe (assoc c list)))

1717 (insert (format "&%s;" (cdr (assoc c list)))))

1718 ((or (equal c ?\n) (equal c ?\r))

1719 (insert "&;")

1720 (forward-char -1))

1721 ((equal c ? )

1722 (insert ?&))

1723 (t (insert (format "&#%d;" c))))))

1724

1725 (defun yahtml:!--\#include ()

1726 (let ((file (yahtml-read-parameter "file" "")))

1727 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1728

1729 (defun yahtml:!--\#exec ()

1730 (format "cmd=\"%s\"--"

1731 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))

1732

1733 ;;; ---------- Jump ----------

1734 (defun yahtml-on-href-p ()

1735 "Check if point is on href clause."

1736 (let ((p (point)) e cmd (case-fold-search t))

1737 (save-excursion

1738 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした

1739 (save-excursion

1740 ;;(search-forward "</a>" nil t) ;aでなくても許可にした

1741 (search-forward "[\" \t\n]" nil t)

1742 (setq e (point)))

1743 ;(goto-char (get 'YaTeX-inner-environment 'point))

1744 (re-search-backward "<\$a\\|link\$\\>" nil t)

1745 (search-forward "href" e t)

1746 (search-forward "=" e t)

1747 (progn

1748 (skip-chars-forward " \t\n")

1749 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

1750 (< p (match-end 0))

1751 (yahtml-unescape-string (YaTeX-match-string 1))))))

1752

1753 (defun yahtml-netscape-sentinel (proc mes)

1754 (cond

1755 ((null (buffer-name (process-buffer proc)))

1756 (set-process-buffer proc nil))

1757 ((eq (process-status proc) 'exit)

1758 (let ((cb (current-buffer)))

1759 (set-buffer (process-buffer proc))

1760 (goto-char (point-min))

1761 (if (search-forward "not running" nil t)

1762 (progn

1763 (message "Starting netscape...")

1764 (start-process

1765 "browser" (process-buffer proc)

1766 shell-file-name yahtml-shell-command-option

1767 (format "%s \"%s\"" yahtml-www-browser

1768 (get 'yahtml-netscape-sentinel 'url)))

1769 (message "Starting netscape...Done")))

1770 (set-buffer cb)))))

1771

1772 (defvar yahtml-browser-process nil)

1773

1774 (defun yahtml-browse-html (href)

1775 "Call WWW Browser to see HREF."

1776 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1777 (cond

1778 ((string-match "^start\\>" yahtml-www-browser)

1779 (if (get-buffer pb)

1780 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1781 (put 'yahtml-netscape-sentinel 'url href)

1782 (set-process-sentinel

1783 (setq yahtml-browser-process

1784 (start-process

1785 "browser" pb shell-file-name yahtml-shell-command-option

1786 (format "%s \"%s\"" yahtml-www-browser href)))

1787 'yahtml-netscape-sentinel))

1788 ((and (string-match

1789 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

1790 (not (eq system-type 'windows-nt)))

1791 (if (get-buffer pb)

1792 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1793 (put 'yahtml-netscape-sentinel 'url href)

1794 (set-process-sentinel

1795 (setq yahtml-browser-process

1796 (start-process

1797 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1798 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1799 'yahtml-netscape-sentinel))

1800 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1801 (w3-fetch href))

1802 ((stringp yahtml-www-browser)

1803 (if (and yahtml-browser-process

1804 (eq (process-status yahtml-browser-process) 'run))

1805 (message "%s is already running" yahtml-www-browser)

1806 (setq yahtml-browser-process

1807 (start-process

1808 "browser" "* WWW Browser *"

1809 shell-file-name yahtml-shell-command-option

1810 (format "%s \"%s\"" yahtml-www-browser href)))))

1811 (t

1812 (message "Sorry, jump across http is not supported.")))))

1813

1814 (defun yahtml-goto-corresponding-href (&optional other)

1815 "Go to corresponding name."

1816 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1817 (if href

1818 (cond

1819 ((string-match "^\$ht\\|f\$tps?:" href)

1820 (yahtml-browse-html href))

1821 (t (setq file (substring href 0 (string-match "#" href)))

1822 (if (string-match "#" href)

1823 (setq name (substring href (1+ (string-match "#" href)))))

1824 (if (string< "" file)

1825 (progn

1826 (if (string-match "/$" file)

1827 (or (catch 'dirindex

1828 (mapcar

1829 (function

1830 (lambda (f)

1831 (if (file-exists-p (concat file f))

1832 (throw 'dirindex

1833 (setq file (concat file f))))))

1834 (yahtml-get-directory-index))

1835 nil)

1836 (setq file (concat file yahtml-directory-index))))

1837 (if (string-match "^/" file)

1838 (setq file (yahtml-url-to-path file)))

1839 (if other (YaTeX-switch-to-buffer-other-window file)

1840 (YaTeX-switch-to-buffer file))

1841 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1842 (if name

1843 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1844 t)))))

1845

1846 (defun yahtml-jump-to-name (name)

1847 "Jump to html's named tag."

1848 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1849 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1850 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1851 (message "Named tag `%s' not found" (substring href 1))))

1852

1853 (defun yahtml-on-begend-p (&optional p)

1854 "Check if point is on begend clause."

1855 (let ((p (or p (point))) cmd (case-fold-search t))

1856 (save-excursion

1857 (goto-char p)

1858 (if (equal (char-after (point)) ?<) (forward-char 1))

1859 (if (and (re-search-backward "<" nil t)

1860 (looking-at

1861 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1862 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1863 (condition-case nil

1864 (forward-list 1)

1865 (error nil))

1866 (< p (point)))

1867 (YaTeX-match-string 1)))))

1868

1869 (defun yahtml-goto-corresponding-begend (&optional noerr)

1870 "Go to corresponding opening/closing tag.

1871 Optional argument NOERR causes no error for unballanced tag."

1872 (let ((cmd (yahtml-on-begend-p)) m0

1873 (p (point)) (case-fold-search t) func str (nest 0))

1874 (cond

1875 (cmd

1876 (setq m0 (match-beginning 0))

1877 (if (= (aref cmd 0) ?/) ;on </cmd> line

1878 (setq cmd (substring cmd 1)

1879 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1880 func 're-search-backward)

1881 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1882 func 're-search-forward))

1883 (while (and (>= nest 0) (funcall func str nil t))

1884 (if (equal m0 (match-beginning 0))

1885 nil

1886 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1887 (if (< nest 0)

1888 (goto-char (match-beginning 0))

1889 (funcall

1890 (if noerr 'message 'error)

1891 "Corresponding tag of `%s' not found." cmd)

1892 (goto-char p)

1893 nil))

1894 (t nil))))

1895

1896 (defun yahtml-current-tag ()

1897 "Return the current tag name including #exec and #include."

1898 (save-excursion

1899 (let ((p (point)) b tag)

1900 (or (bobp)

1901 (looking-at "<")

1902 (progn (skip-chars-backward "^<") (forward-char -1)))

1903 (setq b (point))

1904 (skip-chars-forward "<")

1905 (setq tag (YaTeX-buffer-substring

1906 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1907 (goto-char b)

1908 (forward-list 1)

1909 (and (< p (point)) tag))))

1910

1911 (defun yahtml-get-attrvalue (attr)

1912 "Extract current tag's attribute value from buffer."

1913 (let (e (case-fold-search t))

1914 (save-excursion

1915 (or (looking-at "<")

1916 (progn (skip-chars-backward "^<") (backward-char 1)))

1917 (setq e (save-excursion (forward-list 1) (point)))

1918 (if (and

1919 (re-search-forward (concat "\\b" attr "\\b") e t)

1920 (progn (skip-chars-forward " \t\n=")

1921 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1922 (YaTeX-match-string 1)))))

1923

1924 (defun yahtml-goto-corresponding-img ()

1925 "View image on point"

1926 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1927 (if (and tag

1928 (string-match "img" tag)

1929 (setq image

1930 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1931 (progn

1932 (message "Invoking %s %s..." yahtml-image-viewer image)

1933 (start-process

1934 "Viewer" " * Image Viewer *"

1935 shell-file-name yahtml-shell-command-option ;"-c"

1936 (concat yahtml-image-viewer " " image))

1937 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1938

1939 (defun yahtml-goto-corresponding-source (&optional other)

1940 "Goto applet's or script's source."

1941 (let ((env (yahtml-current-tag)) s (p (point)))

1942 (cond

1943 ((string-match "applet" env)

1944 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1945 (progn

1946 (setq s (YaTeX-match-string 1)

1947 s (concat

1948 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1949 ".java"))

1950 (if other (YaTeX-switch-to-buffer-other-window s)

1951 (YaTeX-switch-to-buffer s))

1952 s) ;return source file name

1953 (message "No applet source specified")

1954 (sit-for 1)

1955 nil))

1956 ((string-match "script" env)

1957 (if (setq s (yahtml-get-attrvalue "src"))

1958 (progn

1959 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1960 'YaTeX-switch-to-buffer)

1961 (yahtml-url-to-path s))

1962 s)))

1963 ((string-match "!--#include" env)

1964 (cond

1965 ((setq s (yahtml-get-attrvalue "file")) ;

1966 (if other (YaTeX-switch-to-buffer-other-window s)

1967 (YaTeX-switch-to-buffer s))

1968 s)

1969 ((setq s (yahtml-get-attrvalue "virtual"));

1970 (setq s (yahtml-url-to-path s))

1971 (if other (YaTeX-switch-to-buffer-other-window s)

1972 (YaTeX-switch-to-buffer s))

1973 s)))

1974 ((and (string-match "!--#exec" env)

1975 (setq s (yahtml-get-attrvalue "cmd")))

1976 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1977 (let ((b " *yahtmltmp*")) ;peek a little

1978 (unwind-protect

1979 (progn

1980 (set-buffer (get-buffer-create b))

1981 (YaTeX-insert-file-contents s nil 0 100)

1982 (if (looking-at "#!")

1983 (if other (YaTeX-switch-to-buffer-other-window s)

1984 (YaTeX-switch-to-buffer s))))

1985 (kill-buffer (get-buffer b)))

1986 (get-file-buffer s))))))

1987

1988 (defun yahtml-goto-corresponding-* (&optional other)

1989 "Go to corresponding object."

1990 (interactive "P")

1991 (cond

1992 ((yahtml-goto-corresponding-href other))

1993 ((yahtml-goto-corresponding-img))

1994 ((yahtml-goto-corresponding-source other))

1995 ((yahtml-goto-corresponding-begend))

1996 (t (message "I don't know where to go."))))

1997

1998 (defun yahtml-goto-corresponding-*-other-window ()

1999 "Go to corresponding object."

2000 (interactive)

2001 (yahtml-goto-corresponding-* t))

2002

2003 (defun yahtml-visit-main ()

2004 "Go to parent file from where you visit current file."

2005 (interactive)

2006 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2007

2008 ;;; ---------- killing ----------

2009 (defun yahtml-kill-begend (&optional whole)

2010 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2011 (if tag

2012 (save-excursion

2013 (or (looking-at "<")

2014 (progn (skip-chars-backward "^<") (forward-char -1)))

2015 (setq p (point))

2016 (yahtml-goto-corresponding-begend)

2017 (or (looking-at "<")

2018 (progn (skip-chars-backward "^<") (forward-char -1)))

2019 (if (< (point) p) ;if on the opening tag

2020 (progn (setq q p p (point))

2021 (goto-char q))

2022 (setq q (point))) ;now q has end-line's (point)

2023 (if (not whole)

2024 (kill-region

2025 (progn (skip-chars-backward " \t")

2026 (if (setq bbolp (bolp)) (point) q))

2027 (progn (forward-list 1)

2028 (setq r (point))

2029 (skip-chars-forward " \t")

2030 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2031 (goto-char p)

2032 (skip-chars-backward " \t")

2033 (if (not whole)

2034 (progn

2035 (kill-append

2036 (buffer-substring

2037 (setq p (if (setq bbolp (bolp)) (point) p))

2038 (setq q (progn

2039 (forward-list 1)

2040 (setq r (point))

2041 (skip-chars-forward " \t")

2042 (if (and bbolp (eolp) (not (eobp)))

2043 (1+ (point))

2044 r))))

2045 t)

2046 (delete-region p q))

2047 (kill-region

2048 (if (bolp) (point) p)

2049 (progn (goto-char q)

2050 (forward-list 1)

2051 (setq r (point))

2052 (skip-chars-forward " \t")

2053 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2054 tag))))

2055

2056 (defun yahtml-kill-* (whole)

2057 "Kill current position's HTML tag (set)."

2058 (interactive "P")

2059 (cond

2060 ((yahtml-kill-begend whole))))

2061

2062

2063 ;;; ---------- changing ----------

2064 (defun yahtml-on-assignment-p ()

2065 "Return if current point is on parameter assignment.

2066 If so, return parameter name, otherwise nil.

2067 This function should be able to treat white spaces in value, but not yet."

2068 (let ((p (point)))

2069 (save-excursion

2070 (put 'yahtml-on-assignment-p 'region nil)

2071 (skip-chars-backward "^ \t\n")

2072 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2073 (< p (match-end 0))

2074 (>= p (1- (match-beginning 2)))

2075 (put 'yahtml-on-assignment-p 'region

2076 (cons (match-beginning 2) (match-end 2)))

2077 (YaTeX-match-string 1)))))

2078

2079 (defun yahtml-change-begend ()

2080 (let ((tag (yahtml-on-begend-p))

2081 (completion-ignore-case t)

2082 (case-fold-search t)

2083 (p (point)) (q (make-marker))

2084 (default (append yahtml-env-table yahtml-typeface-table))

2085 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2086 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2087 href b1 e1 attr new css)

2088 (cond

2089 (tag

2090 (cond

2091 ((and (string-match "^a$" tag)

2092 (save-excursion

2093 (and

2094 (re-search-backward "<a\\b" nil t)

2095 (progn

2096 (goto-char (match-end 0))

2097 (skip-chars-forward " \t\n")

2098 (setq b1 (point))

2099 (search-forward ">" nil t))

2100 (setq e1 (match-beginning 0))

2101 (goto-char b1)

2102 (re-search-forward "href\\s *=" e1 t)

2103 (>= p (point))

2104 (progn

2105 (goto-char (match-end 0))

2106 (skip-chars-forward " \t\n")

2107 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2108 (< p (match-end 0)))))

2109 (setq b1 (match-beginning 1) e1 (match-end 1)

2110 yahtml-completing-buffer (current-buffer)

2111 ;; yahtml-urls-local is buffer-local, so we must put

2112 ;; that into yahtml-urls here

2113 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2114 href (read-from-minibuffer

2115 "Change href to: " "" yahtml-url-completion-map))

2116 (if (string< "" href)

2117 (progn

2118 ;;(setq href ;??

2119 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2120 (delete-region b1 e1)

2121 (goto-char b1)

2122 (insert href))))

2123 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2124 (if (and (equal attr "class") ;treat "class" attribute specially

2125 (setq css (yahtml-css-get-element-completion-alist tag)))

2126

2127 (setq new (yahtml-read-css css))

2128 ;;other than "class", read parameter normally

2129 (setq new (yahtml-read-parameter attr)))

2130 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2131 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2132 (insert new))

2133 (t

2134 (save-excursion

2135 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2136 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2137 (skip-chars-forward "^A-Za-z")

2138 (set-marker q (point))

2139 (setq p (point))

2140 (yahtml-goto-corresponding-begend)

2141 (or (= (char-after (point)) ?<)

2142 (skip-chars-backward "^<"))

2143 (skip-chars-forward "^A-Za-z")

2144 (if (= (char-after (1- (point))) ?/)

2145 (progn

2146 (set-marker q (point))

2147 (goto-char p)))

2148 (setq tag (let ((completion-ignore-case t))

2149 (YaTeX-cplread-with-learning

2150 (format "Change `%s' to(default %s): "

2151 tag yahtml-last-begend)

2152 'default 'user 'tmp)))

2153 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2154 (if (string= "" tag) (setq tag yahtml-last-begend))

2155 (setq yahtml-last-begend

2156 (or (cdr (assoc tag yahtml-env-table)) tag)

2157 tag yahtml-last-begend)

2158 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2159 (insert (format "%s%s" tag (yahtml-addin tag)))

2160 (goto-char q)

2161 (set-marker q nil)

2162 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2163 (insert tag))))

2164 t))))

2165

2166 (defun yahtml-change-command ()

2167 (let ((p (point)) (case-fold-search t) cmd par new

2168 (beg (make-marker)) (end (make-marker)))

2169 (skip-chars-backward "^<")

2170 (if (and

2171 (looking-at yahtml-command-regexp)

2172 (progn

2173 (set-marker beg (match-beginning 0))

2174 (set-marker end (match-end 0))

2175 t) ;for further work

2176 (progn

2177 (forward-char -1)

2178 (condition-case nil

2179 (forward-list 1)

2180 (error nil))

2181 (< p (point))))

2182 (progn

2183 (goto-char p)

2184 (if (setq par (yahtml-on-assignment-p))

2185 (progn

2186 (setq new (yahtml-read-parameter par))

2187 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2188 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2189 (setq new

2190 (YaTeX-cplread-with-learning

2191 "Change form to: "

2192 'yahtml-form-table 'yahtml-user-form-table

2193 'yahtml-tmp-form-table)))

2194 (delete-region beg end)

2195 (goto-char beg)

2196 (set-marker beg nil)

2197 (set-marker end nil)

2198 (insert new)

2199 t)

2200 (goto-char p)

2201 nil)))

2202

2203 (defun yahtml-change-* ()

2204 "Change current position's HTML tag (set)."

2205 (interactive)

2206 (cond

2207 ((yahtml-change-begend))

2208 ((yahtml-change-command))))

2209

2210 ;;; ---------- commenting ----------

2211

2212 (defun yahtml-comment-region (&optional uncom)

2213 "Comment out region or environment."

2214 (interactive)

2215 (let ((e (make-marker)) be beg p)

2216 (cond

2217 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2218 (setq be (yahtml-on-begend-p))

2219 (save-excursion

2220 (setq p (point))

2221 (if (string-match "^/" be)

2222 (setq beg (progn (forward-line 1) (point)))

2223 (setq beg (progn (beginning-of-line) (point))))

2224 (goto-char p)

2225 (yahtml-goto-corresponding-begend)

2226 (if (string-match "^/" be)

2227 (beginning-of-line)

2228 (forward-line 1))

2229 (set-marker e (point))

2230 ;(comment-region beg (point) (if uncom (list 4)))))

2231 ))

2232 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2233 (setq beg (region-beginning))

2234 (set-marker e (region-end))))

2235 (if yahtml-translate-hyphens-when-comment-region

2236 (let ((yahtml-entity-reference-chars-alist-default nil)

2237 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2238 yahtml-entity-reference-chars-regexp

2239 yahtml-entity-reference-chars-reverse-regexp)

2240 (yahtml-entity-reference-chars-setup)

2241 (funcall

2242 (if uncom 'yahtml-translate-reverse-region

2243 'yahtml-translate-region)

2244 beg e)))

2245 (comment-region beg e (if uncom (list 4)))

2246 (set-marker e nil)))

2247

2248 (defun yahtml-uncomment-region ()

2249 (interactive)

2250 (yahtml-comment-region t))

2251

2252 ;;; ---------- translate to entity references ----------

2253 (defvar yahtml-entity-reference-chars-alist-default

2254 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2255 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2256 "Default translation table from character to entity reference")

2257 (defvar yahtml-entity-reference-chars-alist nil

2258 "*Translation table from character to entity reference")

2259 (defvar yahtml-entity-reference-chars-regexp nil)

2260 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2261

2262 (defun yahtml-entity-reference-chars-setup ()

2263 (let ((list (append yahtml-entity-reference-chars-alist-default

2264 yahtml-entity-reference-chars-alist)))

2265 (setq yahtml-entity-reference-chars-regexp "["

2266 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2267 (while list

2268 (setq yahtml-entity-reference-chars-regexp

2269 (concat yahtml-entity-reference-chars-regexp

2270 (char-to-string (car (car list))))

2271 yahtml-entity-reference-chars-reverse-regexp

2272 (concat yahtml-entity-reference-chars-reverse-regexp

2273 (cdr (car list))

2274 (if (cdr list) "\\|")))

2275 (setq list (cdr list)))

2276 (setq yahtml-entity-reference-chars-regexp

2277 (concat yahtml-entity-reference-chars-regexp "]")

2278 yahtml-entity-reference-chars-reverse-regexp

2279 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2280

2281 (yahtml-entity-reference-chars-setup)

2282

2283 (defun yahtml-translate-region (beg end)

2284 "Translate inhibited literals."

2285 (interactive "r")

2286 (save-excursion

2287 (save-restriction

2288 (narrow-to-region beg end)

2289 (let ((ct (append yahtml-entity-reference-chars-alist

2290 yahtml-entity-reference-chars-alist-default)))

2291 (goto-char beg)

2292 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2293 ;(setq c (preceding-char))

2294 (replace-match

2295 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2296

2297 (defun yahtml-translate-reverse-region (beg end)

2298 "Translate entity references to literals."

2299 (interactive "r")

2300 (save-excursion

2301 (save-restriction

2302 (narrow-to-region beg end)

2303 (let ((ct (append yahtml-entity-reference-chars-alist

2304 yahtml-entity-reference-chars-alist-default))

2305 ec)

2306 (goto-char beg)

2307 (while (re-search-forward

2308 yahtml-entity-reference-chars-reverse-regexp nil t)

2309 ;(setq c (preceding-char))

2310 (setq ec (YaTeX-match-string 1))

2311 (delete-region (match-end 0) (match-beginning 0))

2312 (insert (car (YaTeX-rassoc ec ct))))))))

2313

2314 (defun yahtml-inner-environment-but (exclude &optional quick)

2315 "Return the inner environment but matches with EXCLUDE tag."

2316 (let (e (case-fold-search t))

2317 (save-excursion

2318 (while (and (setq e (YaTeX-inner-environment quick))

2319 (string-match exclude e))

2320 (goto-char (get 'YaTeX-inner-environment 'point))))

2321 e))

2322

2323 (defun yahtml-untranslate-string (str)

2324 "Untranslate entity reference."

2325 (let ((md (match-data)) (left "") (right str) b0 ch

2326 (ct (append yahtml-entity-reference-chars-alist

2327 yahtml-entity-reference-chars-alist-default))

2328 (revrex yahtml-entity-reference-chars-reverse-regexp))

2329 (unwind-protect

2330 (progn

2331 (while (string< "" right)

2332 (cond

2333 ((string-match revrex right)

2334 (setq ch (YaTeX-rassoc

2335 (substring right (match-beginning 1) (match-end 1)))

2336 b0 (substring right 0 (match-beginning 0))

2337 right (substring right (match-end 0))

2338 left (concat left

2339 (substring right 0 (match-beginning 0))

2340 (char-to-string ch))))

2341 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2342 (setq ch (substring right (match-beginning 2) (match-end 2))

2343 b0 (substring right 0 (match-beginning 0))

2344 right (substring right (match-end 0))

2345 left (concat left

2346 b0

2347 (char-to-string

2348 (if (match-beginning 1)

2349 (YaTeX-hex ch)

2350 (string-to-number ch))))))

2351 (t (setq left (concat left right)

2352 right ""))))

2353 left)

2354 (store-match-data md))))

2355

2356 ;;; ---------- table-ize region ----------

2357 (defun yahtml-td-region (e delim beg end)

2358 "Enclose each item in a region with <td>..</td>.

2359 Interactive prefix argument consults enclosing element other than td."

2360 (interactive "P\nsDelimiter(s): \nr")

2361 (let ((e (cond

2362 ((null e) "td")

2363 ((stringp e) e)

2364 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2365 (ws "[ \t]")

2366 elm p i)

2367 (if (string= delim "") (setq delim " \t\n"))

2368 (setq delim (concat "[" delim "]+")

2369 elm (if (string= "thd" e)

2370 (cons "th" "td")

2371 (cons e e)))

2372 (save-excursion

2373 (save-restriction

2374 (narrow-to-region beg end)

2375 (goto-char (setq p (point-min)))

2376 (setq i 0 e (car elm))

2377 (while (re-search-forward delim nil t)

2378 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2379 (goto-char (match-beginning 0))

2380 (insert "</" e ">")

2381 (save-excursion

2382 (goto-char p)

2383 (insert "<" e ">"))

2384 (setq p (point))

2385 (while (and (not (eobp)) (looking-at ws))

2386 (delete-char 1))

2387 (if (looking-at delim) (delete-char 1)))

2388 (insert "<" e ">")

2389 (goto-char (point-max))

2390 (insert "</" e ">")))))

2391

2392 (defun yahtml-tr-region (e delim beg end)

2393 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2394 (interactive "P\nsDelimiter(s): \nr")

2395 (setq e (if (and e (listp e))

2396 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2397 "th")))

2398 (save-excursion

2399 (save-restriction

2400 (narrow-to-region (point) (mark))

2401 (goto-char (point-min))

2402 (while (not (eobp))

2403 (insert "<tr>")

2404 (yahtml-td-region e delim (point) (point-end-of-line))

2405 (end-of-line)

2406 (insert "</tr>")

2407 (forward-line 1)))))

2408

2409 ;;; ---------- filling ----------

2410 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2411 (defun yahtml-move-to-column (col &optional force)

2412 (beginning-of-line)

2413 (let ((ccol 0))

2414 (while (and (> col ccol) (not (eolp)))

2415 (if (eq (following-char) ?\<)

2416 (progn

2417 (while (and (not (eq (following-char) ?\>))

2418 (not (eolp)))

2419 (forward-char))

2420 (or (eolp) (forward-char)))

2421 (or (eolp) (forward-char))

2422 (if (eq (preceding-char) ?\t)

2423 (let ((wd (- 8 (% (+ ccol 8) 8))))

2424 (if (and force (< col (+ ccol wd)))

2425 (progn

2426 (backward-char 1)

2427 (insert-char ?\ (- col ccol))

2428 (setq ccol col))

2429 (setq ccol (+ ccol wd))))

2430 (setq ccol (1+ ccol)))

2431 (if (and YaTeX-japan

2432 (or

2433 (and (fboundp 'char-category)

2434 (string-match "[chj]" (char-category (preceding-char))))

2435 (and (fboundp 'char-charset)

2436 (not (eq (char-charset (preceding-char)) 'ascii)))))

2437 (setq ccol (1+ ccol)))))

2438 (if (and force (> col ccol))

2439 (progn

2440 (insert-char ?\ (- col ccol))

2441 col)

2442 ccol)))

2443

2444 (defun yahtml-fill-paragraph (arg)

2445 (interactive "P")

2446 (let*((case-fold-search t) (p (point)) fill-prefix

2447 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2448 indent

2449 (startp (get 'YaTeX-inner-environment 'point))

2450 (prep (string-match "^pre$" e))

2451 (ps1 (if prep (default-value 'paragraph-start)

2452 paragraph-start))

2453 (ps2 (if prep (concat (default-value 'paragraph-start)

2454 "$\\|^\\s *</?pre>")

2455 paragraph-start)))

2456 (save-excursion

2457 (unwind-protect

2458 (progn

2459 (if prep

2460 (fset 'move-to-column 'yahtml-move-to-column))

2461 (save-excursion

2462 (beginning-of-line)

2463 (indent-to-column (yahtml-this-indent))

2464 (setq fill-prefix

2465 (buffer-substring (point) (point-beginning-of-line)))

2466 (delete-region (point) (point-beginning-of-line)))

2467 (fill-region-as-paragraph

2468 (progn (re-search-backward paragraph-start nil t)

2469 (or (save-excursion

2470 (goto-char (match-beginning 0))

2471 (if (looking-at "<")

2472 (forward-list)

2473 (goto-char (match-end 0))

2474 (skip-chars-forward " \t>"))

2475 (if (looking-at "[ \t]*$")

2476 (progn (forward-line 1) (point))))

2477 (point)))

2478 (progn (goto-char p)

2479 (re-search-forward ps2 nil t)

2480 (match-beginning 0))))

2481 (fset 'move-to-column yahtml-saved-move-to-column)))))

2482

2483 ;(defun yahtml-indent-new-commnet-line ()

2484 ; (unwind-protect

2485 ; (progn

2486 ; (fset 'move-to-column 'yahtml-move-to-column)

2487 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2488 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2489

2490 ;;;

2491 ;;; ---------- indentation ----------

2492 ;;;

2493 (defun yahtml-indent-line ()

2494 "Indent a line (faster wrapper)"

2495 (interactive)

2496 (let (indent)

2497 (if (and (save-excursion

2498 (beginning-of-line) (skip-chars-forward "\t ")

2499 (not (looking-at "<")))

2500 (save-excursion

2501 (forward-line -1)

2502 (while (and (not (bobp)) (looking-at "^\\s *$"))

2503 (forward-line -1))

2504 (skip-chars-forward "\t ")

2505 (setq indent (current-column))

2506 (not (looking-at "<"))))

2507 (progn

2508 (save-excursion

2509 (beginning-of-line)

2510 (skip-chars-forward " \t")

2511 (or (= (current-column) indent)

2512 (YaTeX-reindent indent)))

2513 (and (bolp) (skip-chars-forward " \t")))

2514 (yahtml-indent-line-real))))

2515

2516 (defun yahtml-this-indent ()

2518 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2519 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2520 (excludes

2521 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2522 inenv p col peol (case-fold-search t))

2523 (save-excursion

2524 (beginning-of-line)

2525 (setq inenv (or (yahtml-inner-environment-but excludes t)

2526 "html")

2527 col (get 'YaTeX-inner-environment 'indent)

2528 p (get 'YaTeX-inner-environment 'point)

2529 op nil))

2530 (save-excursion

2531 (cond

2532 ((string-match (concat "^\$" envs "\$") inenv)

2533 (save-excursion

2534 (beginning-of-line)

2535 (skip-chars-forward " \t")

2536 (cond ;lookup current line's tag

2537 ((looking-at (concat "</\$" envs "\$>"))

2538 col)

2539 ((looking-at itms)

2540 (+ col yahtml-environment-indent))

2541 ((and yahtml-hate-too-deep-indentation

2542 (looking-at (concat "<\$" envs "\$")))

2543 (+ col (* 2 yahtml-environment-indent)))

2544 ((and (< p (point))

2545 (string-match itemizing-envs inenv)

2546 (save-excursion

2547 (and

2548 (setq op (point))

2549 (goto-char p)

2550 (re-search-forward itms op t)

2551 (progn

2552 (if yahtml-indent-listing-constant

2553 (setq col (+ (current-column)

2554 (if yahtml-faithful-to-htmllint 1 2)))

2555 (skip-chars-forward "^>")

2556 (skip-chars-forward ">")

2557 (skip-chars-forward " \t")

2558 (setq col (if (looking-at "$")

2559 (+ col yahtml-environment-indent)

2560 (current-column))))))))

2561 col)

2562 (t

2563 (+ col yahtml-environment-indent)))))

2564 (t col)))))

2565

2566 (defun yahtml-indent-line-real ()

2567 "Indent current line."

2568 (interactive)

2569 (YaTeX-reindent (yahtml-this-indent))

2570 (if (bolp) (skip-chars-forward " \t"))

2571 (let (peol col inenv)

2572 (if (and (setq inenv (yahtml-on-begend-p))

2573 (string-match

2574 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2575 (save-excursion

2576 (setq peol (point-end-of-line))

2577 (or (= (char-after (point)) ?<)

2578 (progn (skip-chars-backward "^<") (forward-char -1)))

2579 (setq col (current-column))

2580 (if (and (yahtml-goto-corresponding-begend t)

2581 (> (point) peol)) ;if on the different line

2582 (YaTeX-reindent col))))))

2583

2584 ;(defun yahtml-fill-item ()

2585 ; "Fill item HTML version"

2586 ; (interactive)

2587 ; (let (inenv p fill-prefix peol (case-fold-search t))

2588 ; (setq inenv (or (YaTeX-inner-environment) "html")

2589 ; p (get 'YaTeX-inner-environment 'point))

2590 ; (cond

2591 ; ((string-match "^[uod]l" inenv)

2592 ; (save-excursion

2593 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2594 ; (progn

2595 ; (goto-char (match-end 0))

2596 ; (setq col (current-column)))

2597 ; (error "No <li>, <dt>, <dd>")))

2598 ; (save-excursion

2599 ; (end-of-line)

2600 ; (setq peol (point))

2601 ; (newline)

2602 ; (indent-to-column col)

2603 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2604 ; (delete-region (point) peol)

2605 ; (fill-region-as-paragraph

2606 ; (progn (re-search-backward paragraph-start nil t) (point))

2607 ; (progn (re-search-forward paragraph-start nil t 2)

2608 ; (match-beginning 0)))))

2609 ; (t nil))))

2610

2611 ;;;

2612 ;;; ---------- Lint and Browsing ----------

2613 ;;;

2614 (defun yahtml-browse-menu ()

2615 "Browsing or other external process invokation menu."

2616 (interactive)

2617 (message "J)weblint p)Browse R)eload N)ewpage...")

2618 (let ((c (char-to-string (read-char))))

2619 (cond

2620 ((string-match "j" c)

2621 (yahtml-lint-buffer (current-buffer)))

2622 ((string-match "[bp]" c)

2623 (yahtml-browse-current-file))

2624 ((string-match "r" c)

2625 (yahtml-browse-reload))

2626 ((string-match "n" c)

2627 (call-interactively 'yahtml-newpage)))))

2628

2629 (if (fboundp 'wrap-function-to-control-ime)

2630 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2631

2632 (defvar yahtml-lint-buffer "*weblint*")

2633

2634 (defun yahtml-lint-buffer (buf)

2635 "Call lint on buffer BUF."

2636 (require 'yatexprc)

2637 (interactive "bCall lint on buffer: ")

2638 (setq buf (get-buffer buf))

2639 (YaTeX-save-buffers)

2640 (let ((bcmd (YaTeX-get-builtin "lint")))

2641 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2642 (YaTeX-typeset

2643 (concat (or bcmd yahtml-lint-program)

2644 " " (file-name-nondirectory (buffer-file-name buf)))

2645 yahtml-lint-buffer "lint" "lint")))

2646

2647 (defun yahtml-file-to-url (file)

2648 "Convert local unix file name to URL.

2649 If no matches found in yahtml-path-url-alist, return raw file name."

2650 (let ((list yahtml-path-url-alist) p url)

2651 (if (file-directory-p file)

2652 (setq file (expand-file-name yahtml-directory-index file))

2653 (setq file (expand-file-name file)))

2654 (if (string-match "^[A-Za-z]:/" file)

2655 (progn

2656 ;; (aset file 1 ?|) ;これは要らないらしい…

2657 (setq file (concat "///" file))))

2658 (while list

2659 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2660 (setq url (cdr (car list))

2661 file (substring file (match-end 0))

2662 url (concat url file)

2663 list nil))

2664 (setq list (cdr list)))

2665 (or url (concat "file:" file))))

2666

2667 (defun yahtml-url-to-path (file &optional basedir)

2668 "Convert local URL name to unix file name."

2669 (let ((list yahtml-path-url-alist) url realpath docroot

2670 (dirsufp (string-match "/$" file)))

2671 (setq basedir (or basedir

2672 (file-name-directory

2673 (expand-file-name default-directory))))

2674 (cond

2675 ((string-match "^/" file)

2676 (while list

2677 (if (file-directory-p (car (car list)))

2678 (progn

2679 (setq url (cdr (car list)))

2680 (if (string-match "\$http://[^/]*\$/" url)

2681 (setq docroot (substring url (match-end 1)))

2682 (setq docroot url))

2683 (cond

2684 ((string-match (concat "^" (regexp-quote docroot)) file)

2685 (setq realpath

2686 (expand-file-name

2687 (substring

2688 file

2689 (if (= (aref file (1- (match-end 0))) ?/)

2690 (match-end 0) ; "/foo"

2691 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2692 (car (car list))))))

2693 (if realpath

2694 (progn (setq list nil)

2695 (if (and dirsufp (not (string-match "/$" realpath)))

2696 (setq realpath (concat realpath "/")))))))

2697 (setq list (cdr list)))

2698 realpath)

2699 (t file))))

2700

2701 (defun yahtml-browse-current-file ()

2702 "Call WWW browser on current file."

2703 (interactive)

2704 (basic-save-buffer)

2705 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2706

2707 (defun yahtml-browse-reload ()

2708 "Send `reload' event to netscape."

2709 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2710 (cond

2711 ((string-match "[Nn]etscape" yahtml-www-browser)

2712 (if (get-buffer pb)

2713 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2714 ;;(or (get 'yahtml-netscape-sentinel 'url)

2715 ;; (error "Reload should be called after Browsing."))

2716 (put 'yahtml-netscape-sentinel 'url

2717 (yahtml-file-to-url (buffer-file-name)))

2718 (basic-save-buffer)

2719 (set-process-sentinel

2720 (setq yahtml-browser-process

2721 (start-process

2722 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2723 (format "%s -remote 'reload'" yahtml-www-browser)))

2724 'yahtml-netscape-sentinel))

2725 (t

2726 (message "Sorry, RELOAD is supported only for Netscape.")))))

2727

2728 ;;; ---------- Intelligent newline ----------

2729 (defun yahtml-intelligent-newline (arg)

2730 "Intelligent newline for HTML"

2731 (interactive "P")

2732 (let (env func)

2733 (end-of-line)

2734 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2735 "html")))

2736 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2737 (newline)

2738 (if (and env func (fboundp func))

2739 ;; if intelligent line function is defined, call that

2740 (funcall func)

2741 ;; else do the default action

2742 (if (string-match yahtml-p-prefered-env-regexp env)

2743 (yahtml-insert-p)))))

2744

2745 (defun yahtml-intelligent-newline-ul ()

2746 (interactive)

2747 (yahtml-insert-single "li")

2748 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2749 (yahtml-indent-line))

2750

2751 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2752

2753 (defun yahtml-intelligent-newline-dl ()

2754 (interactive)

2755 (let ((case-fold-search t))

2756 (if (save-excursion

2757 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2758 (get 'YaTeX-inner-environment 'point) t))

2759 (cond

2760 ((match-beginning 2)

2761 (yahtml-insert-single "dd")

2762 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2763 (setq yahtml-last-single-cmd "dt"))

2764 ((match-beginning 3)

2765 (yahtml-insert-single "dt")

2766 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2767 (setq yahtml-last-single-cmd "dd")))

2768 (yahtml-insert-single "dt")

2769 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2770 (setq yahtml-last-single-cmd "dd"))

2771 (yahtml-indent-line)

2772 (and (string-match yahtml-p-prefered-env-regexp "dl")

2773 (string-equal yahtml-last-single-cmd "dt")

2774 (yahtml-insert-p nil))))

2775

2776 (defun yahtml-intelligent-newline-select ()

2777 (interactive)

2778 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2779 (yahtml-indent-line))

2780

2781 (defun yahtml-intelligent-newline-style ()

2782 (interactive)

2783 (if (save-excursion

2784 (and

2785 (re-search-backward "<style\\|<!-- " nil t)

2786 (looking-at "<style")))

2787 (let (c)

2788 (yahtml-indent-line)

2789 (setq c (current-column))

2790 (insert "<!--\n")

2791 (YaTeX-reindent c)

2792 (insert "-->")

2793 (beginning-of-line)

2794 (open-line 1)

2795 (YaTeX-reindent c))))

2796

2797 (defun yahtml-intelligent-newline-head ()

2798 (let ((title (read-string "Document title: "))

2799 (b "<title>") (e "</title>") p)

2800 (yahtml-indent-line)

2801 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2802 (setq p (point))

2803 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2804 (if (string= "" title) (goto-char p))

2805 (setq yahtml-last-begend "body")))

2806

2807 (defun yahtml-intelligent-newline-script ()

2808 (let ((p (point)) b)

2809 (if (save-excursion

2810 (and

2811 (setq b (re-search-backward "<script\\>" nil t))

2812 (re-search-forward

2813 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2814 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2815 c (srcp (re-search-backward "src=" b t)))

2816 (goto-char p)

2817 (yahtml-indent-line)

2818 (setq c (current-column))

2819 (if srcp

2820 nil

2821 (insert "")

2822 (beginning-of-line)

2823 (open-line 1)

2824 (YaTeX-reindent c))))))

2825

2826 (defun yahtml-intelligent-newline-table ()

2827 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2828 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2829 (cond

2830 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2831 (while (and (setq rb (re-search-backward ptn tb t))

2832 (match-beginning 1))

2833 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2834 (goto-char (match-end 0))

2835 (skip-chars-forward " \t\n")

2836 (if (and (search-forward "colspan\\s *=" p t)

2837 (progn

2838 (skip-chars-forward "\"' \t\n")

2839 (looking-at "[0-9]+")))

2840 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2841 (setq cols (1+ cols)))

2842 (goto-char rb)

2843 (setq p (point)))

2844 (if (> cols 0)

2845 (message "%s columns found. %s"

2846 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2847 "New tr?(N) or Duplicate")))

2848 (cond

2849 ((and (> cols 0)

2850 (memq (read-char) '(?d ?D))) ;Duplication mode

2851 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2852 (t ;empty cells

2853 (setq line "<tr>" i 0)

2854 (if (> cols 0)

2855 (while (> cols i)

2856 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2857 "<td></td>"))

2858 th nil i (1+ i)))

2859 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2860 (while (string-match "t\$h\$\\|td" fmt i)

2861 (setq line (concat line (if (match-beginning 1) "<th></th>"

2862 "<td></td>"))

2863 i (match-end 0))))

2864 (setq line (concat line "</tr>"))))

2865 (goto-char cp)

2866 (if th

2867 (message

2868 "Type `%s' to change td from/to th."

2869 (key-description (car (where-is-internal 'yahtml-change-*)))))

2870 (if (string< "" line)

2871 (progn

2872 (insert line)

2873 (goto-char (+ 8 cp))

2874 (yahtml-indent-line)))))))

2875

2876 ;;; ---------- Marking ----------

2877 (defun yahtml-mark-begend ()

2878 "Mark current tag"

2879 (interactive)

2880 (YaTeX-beginning-of-environment)

2881 (let ((p (point)))

2882 (save-excursion

2883 (skip-chars-backward " \t" (point-beginning-of-line))

2884 (if (bolp) (setq p (point))))

2885 (push-mark p t))

2886 (yahtml-goto-corresponding-begend)

2887 (forward-list 1)

2888 (if (eolp) (forward-char 1)))

2889

2890 ;;; ---------- complete marks ----------

2891 (defun yahtml-complete-mark ()

2892 "Complete &gt, &lt, &ampersand, and &quote."

2893 (interactive)

2894 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2895 (let ((c (read-char)))

2896 (setq c (if (or (< c ?0) (> c ?7))

2897 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2898 (- c ?1)))

2899 (if (or (< c 0) (> c 6))

2900 nil

2901 (insert (format "&%s;"

2902 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2903

2904

2905 ;;; ---------- jump to error line ----------

2906 (defun yahtml-prev-error ()

2907 "Jump to previous error seeing lint buffer."

2908 (interactive)

2909 (or (get-buffer yahtml-lint-buffer)

2910 (error "No lint program ran."))

2911 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2912 (yahtml-jump-to-error-line t))

2913

2914 (defun yahtml-jump-to-error-line (&optional sit)

2915 (interactive "P")

2916 (let ((p (point)) (e (point-end-of-line)))

2917 (end-of-line)

2918 (if (re-search-backward yahtml-error-line-regexp nil t)

2919 (let ((f (if (string= "" (YaTeX-match-string 1))

2920 YaTeX-current-file-name

2921 (YaTeX-match-string 1)))

2922 (l (string-to-int (or (YaTeX-match-string 2)

2923 (YaTeX-match-string 3)))))

2924 (if sit (sit-for 1))

2925 (forward-line -1)

2926 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2927 (goto-line l))

2928 (message "No line number usage"))))

2929

2930 ;;; ---------- Style Sheet Support ----------

2931 (defvar yahtml-css-class-alist nil

2932 "Alist of elements vs. their classes")

2933

2934 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2935 (save-excursion

2936 (save-restriction

2937 (narrow-to-region beg end)

2938 (goto-char (point-min))

2939 (let ((alist initial) b e element class a)

2940 (setq b (point))

2941 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2942 (if (match-beginning 2)

2943 (let ((f (YaTeX-buffer-substring

2944 (progn (skip-chars-forward "^\"")(1+ (point)))

2945 (progn (forward-char 1)

2946 (skip-chars-forward "^\"")(point)))))

2947 (if (file-exists-p f)

2948 (setq alist

2949 (append alist (yahtml-css-collect-classes-file

2950 f initial)))))

2951 (setq e (point))

2952 (goto-char b)

2953 (while (re-search-forward ;ちょといい加減なREGEXP

2954 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2955 e t)

2956 (setq element (YaTeX-match-string 1)

2957 class (YaTeX-match-string 2))

2958 ;;if starts with period (match-string 1 is nil),

2959 ;;this is global class

2960 (setq element (downcase (or element "*")))

2961 (if (setq a (assoc element alist))

2962 (or (assoc class (cdr a))

2963 (setcdr a (cons (list class) (cdr a))))

2964 (setq alist (cons (list element (list class)) alist))))

2965 (goto-char (1- e))

2966 (search-forward "}" nil 1) ;1=move to limit when not found.

2967 (setq b (point))))

2968 alist))))

2969

2970 (defun yahtml-css-collect-classes-buffer (&optional initial)

2971 (interactive)

2972 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2973

2974 (defun yahtml-css-collect-classes-file (file &optional initial)

2975 (let*((hilit-auto-highlight nil)

2976 (buf (get-buffer-create

2977 (format " *css-collection*%s" (file-name-nondirectory file))))

2978 (cb (current-buffer)))

2979 (unwind-protect

2980 (progn

2981 (set-buffer buf)

2982 (insert-file-contents file)

2983 (cd (or (file-name-directory file) "."))

2984 (yahtml-css-collect-classes-buffer initial))

2985 (if (eq buf cb)

2986 nil

2987 (kill-buffer buf)

2988 (set-buffer cb)))))

2989

2990 (defun yahtml-css-scan-styles ()

2991 (save-excursion

2992 (goto-char (point-min))

2993 (set (make-local-variable 'yahtml-css-class-alist) nil)

2994 (let (b tag type e href alist)

2995 (while (re-search-forward "<\$style\\|link\$" nil t)

2996 (setq b (match-beginning 0)

2997 tag (YaTeX-match-string 1))

2998 (cond

2999 ((string-match "style" tag)

3000 (goto-char b)

3001 (save-excursion (forward-list 1) (setq e (point)))

3002 (cond

3003 ((search-forward "text/css" e 1) ;css definition starts

3004 (setq alist

3005 (yahtml-css-collect-classes-region

3006 (point) (progn (search-forward "</style>") (point))

3007 alist)))))

3008 ((and (string-match "link" tag)

3009 (stringp (setq type (yahtml-get-attrvalue "type")))

3010 (string-match "text/css" type)

3011 (setq href (yahtml-get-attrvalue "href"))

3012 (file-exists-p (yahtml-url-to-path href)))

3013 (setq alist

3014 (yahtml-css-collect-classes-file

3015 (yahtml-url-to-path href) alist))))

3016 (setq yahtml-css-class-alist alist)))))

3017

3018 (defun yahtml-css-get-element-completion-alist (element)

3019 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3020 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3021 (and (or alist global)

3022 (append alist global))))

3023

3024 ;;; ---------- ----------

3025

3026 ;;;

3027 ;;hilit19

3028 ;;;

3029 (defvar yahtml-default-face-table

3030 '(

3031 (form black/ivory white/hex-442233 italic)

3032 ))

3033 (defvar yahtml-hilit-patterns-alist

3034 '(

3035 'case-fold

3036 ;; comments

3037 ("" comment)

3038 ;; include&exec

3039 ("" include)

3040 ;; string

3041 (hilit-string-find ?\\ string)

3042 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3043 ("</?[uod]l>" 0 decl)

3044 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3045 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3046 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3047 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3048 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3049 ))

3050

3051 (defun yahtml-hilit-region-tag (tag)

3052 "Return list of start/end point of <TAG> form."

3053 (if (re-search-forward tag nil t)

3054 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3055 (elm (YaTeX-match-string 1)))

3056 (skip-chars-forward "^>")

3057 (prog1

3058 (cons (1+ (point))

3059 (progn (re-search-forward (concat "</" elm ">") nil t)

3060 (match-beginning 0)))

3061 (goto-char e0)))))

3062

3063 (defun yahtml-hilit-region-tag-itself (ptn)

3064 "Return list of start/end point of <tag options...> itself."

3065 (if (re-search-forward ptn nil t)

3066 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3067 (skip-chars-forward "^<>")

3068 (if (eq (char-after (point)) ?<) nil

3069 (prog1

3070 (cons m0 (min (point-max) (1+ (point))))

3071 (goto-char e0))))))

3072

3073 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3074 (and yahtml-use-hilit19

3075 (or (assq 'yahtml-mode hilit-patterns-alist)

3076 (setq hilit-patterns-alist

3077 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3078 hilit-patterns-alist))))

3079 ;;;

3080 ;; for font-lock

3081 ;;;

3082

3083 ; <<STATIC KEYWORDS BELOW NOT USED>>

3084 ;(defvar yahtml-font-lock-keywords

3085 ; '(

3086 ; ;; comments

3087 ; ("" . font-lock-comment-face)

3088 ; ;; include&exec

3089 ; (""

3090 ; 0 font-lock-include-face keep)

3091 ; ;; string

3092 ; ;(hilit-string-find ?\\ string)

3093 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3094 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3095 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3096 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3097 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3098 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3099 ; )

3100 ; "*Defualt font-lock-keywords for yahtml-mode.")

3101 (defvar yahtml-font-lock-keywords

3102 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3103 "Default fontifying patterns for yahtml-mode")

3104

3105 (defun yahtml-font-lock-set-default-keywords ()

3106 (put 'yahtml-mode 'font-lock-defaults

3107 '(yahtml-font-lock-keywords nil t)))

3108

3109 (if yahtml-use-font-lock

3110 (progn

3111 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3112 ;;for those who use both hilit19 and font-lock

3113 (if (eq (car hilit-mode-enable-list) 'not)

3114 (or (member 'yahtml-mode hilit-mode-enable-list)

3115 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3116 (setq hilit-mode-enable-list

3117 (delq 'yahtml-mode hilit-mode-enable-list))))

3118 (yahtml-font-lock-set-default-keywords)))

3119

3120 (defun yahtml-font-lock-recenter (&optional arg)

3121 (interactive "P")

3122 (font-lock-mode -1) ;is stupid, but sure.

3123 (font-lock-mode 1))

3124

3125 (run-hooks 'yahtml-load-hook)

3126 (provide 'yahtml)

3127

3128 ; Local variables:

3129 ; fill-prefix: ";;; "

3130 ; paragraph-start: "^$\\|\\|;;;$"

3131 ; paragraph-separate: "^$\\|\\|;;;$"

3132 ; coding: sjis

3133 ; End: