yatex: 9cef5d10a0f1 yahtml.el

yatex

view yahtml.el @ 330:9cef5d10a0f1

First Drag-n-Drop support

author	HIROSE Yuuji <yuuji@gentei.org>
date	Tue, 16 Dec 2014 11:12:38 +0900
parents	1bbc6cff5b6c
children	2a72779d9c50

line source

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

3 ;;; Last modified Tue Dec 16 11:11:25 2014 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.77"

7 "Revision number of running yahtml.el")

9 ;;; Commentary:

11 ;;;[Installation]

12 ;;;

13 ;;; First, you have to install YaTeX and make sure it works fine. Then

14 ;;; put these expressions into your ~/.emacs

15 ;;;

16 ;;; (setq auto-mode-alist

17 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))

18 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)

19 ;;; (setq yahtml-www-browser "firefox")

20 ;;; ;Write your favorite browser. But firefox is advantageous.

21 ;;; (setq yahtml-path-url-alist

22 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")

23 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))

24 ;;; ;Write correspondence alist from ABSOLUTE unix path name to URL path.

25 ;;;

26 ;;;[インストール方法]

27 ;;;

28 ;;; yahtml.el, yatexlib.el, yatexprc.el を load-path の通ったディレクト

29 ;;; リにインストールしてください。その後、以下を参考に ~/.emacs に設定を

30 ;;; 追加して下さい。

31 ;;;

32 ;;; (setq auto-mode-alist

33 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))

34 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)

35 ;;; (setq yahtml-www-browser "firefox")

36 ;;; ;お気に入りのブラウザを書いて下さい。firefoxが便利です。

37 ;;; (setq yahtml-path-url-alist

38 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")

39 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))

40 ;;; ;UNIXの絶対パスと対応するURLのリストを書いて下さい。

41 ;;;

42 ;;; HTMLファイル漢字コードが正しく判別されるようにホームディレクトリに

43 ;;; .htaccess ファイルを作り以下のどれか1行を選んで書いて下さい。

44 ;;;

45 ;;; AddType "text/html; charset=Shift_JIS" .html (SJISの場合)

46 ;;; AddType "text/html; charset=iso2022-jp" .html (JISの場合)

47 ;;; AddType "text/html; charset=EUC-JP" .html (EUCの場合)

48 ;;; AddType "text/html; charset=utf-8" .html (UTF-8の場合)

49 ;;;

50 ;;; .htaccess が作れない場合は

51 ;;; (setq yahtml-kanji-code 2)

52 ;;; ;HTMLファイルの漢字コードを変更する場合は

53 ;;; ;1=SJIS、2=JIS、3=EUC 4=UTF-8

54 ;;; ;で設定して下さい。デフォルトは 2 です。

55 ;;;

56 ;;; を適切に書き換えて ~/.emacs に足して下さい。

57 ;;;

58 ;;;[Commentary]

59 ;;;

60 ;;; It is assumed you are already familiar with YaTeX. The following

61 ;;; completing featureas are available: ([prefix] means `C-c' by default)

62 ;;;

63 ;;; * [prefix] b X Complete environments such as `H1' which

64 ;;; normally requires closing tag `</H1>

65 ;;; <a href=foo> ... </a> is also classified into

66 ;;; this group

67 ;;; When input `href=...', you can complete file

68 ;;; name or label(href="#foo") by typing TAB.

69 ;;; * [prefix] l Complete typeface-changing commands such as

70 ;;; `<i> ... </i>' or `<samp> ... </samp>'

71 ;;; This completion can be used to make in-line

72 ;;; tags which is normally completed with [prefix] b.

73 ;;; * [prefix] s Complete declarative notations such as

74 ;;; `<img src="foo.gif">'

75 ;;; `<input name="var" ...>'

76 ;;; * [prefix] m Complete single commands such as

77 ;;; `<br>' or `<hr> or <li>...'

78 ;;; * [prefix] p Insert <p></p> on the point

79 ;;; * M-RET Intelligent newline; if current TAG is one of

80 ;;; ul, ol, or dl. insert newline and <li> or

81 ;;; <dt> or <dd> suitable for current condition.

82 ;;; * menu-bar yahtml Complete all by selecting a menu item (Though I

83 ;;; hate menu, this is most useful)

84 ;;; * [prefix] g Goto corresponding Tag or HREF such as

85 ;;; <dl> <-> </dl> or href="xxx".

86 ;;; Or invoke image viewer if point is on <img src=...>.

87 ;;; * [prefix] k Kill html tags on the point. If you provide

88 ;;; universal-argument, kill surrounded contents too.

89 ;;; * [prefix] c Change html tags on the point.

90 ;;; When typeing [prefix] c on `href="xxx"', you can

91 ;;; change the reference link with completion.

92 ;;; * [prefix] t j Call weblint on current file.

93 ;;; * [prefix] t p View current html with WWW browser

94 ;;; (To activate this, never fail to set the lisp

95 ;;; variable yahtml-www-browser. Recommended value

96 ;;; is "firefox")

97 ;;; * [prefix] a YaTeX's accent mark's equivalent of yahtml.

98 ;;; This function can input $lt, $gt or so.

99 ;;; * [prefix] ; Translate chars of `>', `<', `&', and `"' to

100 ;;; `>', `<', `&', `"' respectively

101 ;;; in the region.

102 ;;; * [prefix] : Do translation opposite to above, in the region.

103 ;;; * [prefix] # Translate unsafe-chars and unreserved-chars to

104 ;;; URLencoded string in the region.

105 ;;;

106 ;;;[キーの説明]

107 ;;;

108 ;;; 以下の説明において、特にカスタマイズをしていない限り、[prefix] は

109 ;;; C-c キーを意味します。

110 ;;;

111 ;;; * [prefix] b X `</H1>' といった終了タグが必要となる`H1'のよう

112 ;;; な環境を補完入力します。<a href=foo> ... </a>

113 ;;; もこのグループです。

114 ;;; `href=...' と入力した後、TABキーを押すことで、

115 ;;; ファイル名や (href="#foo") のようなラベルも補完

116 ;;; できます。

117 ;;; * [prefix] s 以下のような宣言の補完を行います。

118 ;;; `<img src="foo.gif">'

119 ;;; `<input name="var" ...>'

120 ;;; * [prefix] l `<i> ... </i>' や `<samp> ... </samp>' のよう

121 ;;; なテキストスタイル指定のタグを補完します。

122 ;;; この補完機能は通常 [prefix] b で補完できるものを

123 ;;; 一行内で書きたいときにも用いることが出来ます。

124 ;;; * [prefix] m `<br>' や `<hr> '、`<li>' 等の単体タグの補完

125 ;;; を行います。

126 ;;; * [prefix] p カーソル位置に<p></p>を挿入します。

127 ;;; * M-RET おまかせ改行; もしul、ol、dl等のタグ(リスト)を

128 ;;; 使っている場合に、環境に合わせて改行と <li>、

129 ;;; <dt>、<dd>を入力します。

130 ;;; * menu-bar yahtml 選択したアイテムをメニューより補完できます。

131 ;;; (私はメニューが嫌いなんですが、htmlに関してはメ

132 ;;; ニューは一番ありがたいかも)

133 ;;; * [prefix] g 対応するタグ、<dl> <-> </dl> や href="xxx" の

134 ;;; ような TAG にジャンプします。

135 ;;; <img src=...> の場合はイメージビューワを呼び出

136 ;;; します。href=hoge.html の場合はhoge.htmlに飛びま

137 ;;; す。

138 ;;; * [prefix] k ポイント上の HTML タグを消去します。

139 ;;; もし universal-argument を付けた場合(C-uを先に押

140 ;;; す)HTMLタグで囲まれた内容も同時に消去します。

141 ;;; * [prefix] c ポイント上のタグを変更します。

142 ;;; `href="xxx"'の上で [prefix] c を利用した場合は、

143 ;;; 参照しているリンクを補完機能を使いながら変更で

144 ;;; きます。

145 ;;; * [prefix] t j カレントファイルに対して jweblint を呼び出しま

146 ;;; す。ファイル先頭付近に

147 ;;;

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

441 ))

442

443 (if yahtml-html4-strict

444 (setq yahtml-env-table

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

446

447 ;(defvar yahtml-itemizing-regexp

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

449 ; "Regexp of itemizing forms")

450

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

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

453

454 ;;; Completion tables for typeface designator

455 (and yahtml-always-/p

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

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

458 (and yahtml-always-/li

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

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

461 (and yahtml-always-/dt

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

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

464 (and yahtml-always-/dd

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

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

467

468 (defvar yahtml-typeface-table

469 (append

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

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

472 ("sup") ("sub") ("span") ("abbr"))

473 (if (not yahtml-html4-strict)

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

475 yahtml-env-table)

476 "Default completion table of typeface designator")

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

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

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

480

481 (defvar yahtml-single-cmd-table

482 '(("hr") ("br") ("option")

483 ("HorizontalRule" . "hr")

484 ("BreakLine" . "br")

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

486 ("!--#exec")

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

488 ("!--#include")

489 ;; ("Item" . "li")

490 ;; ("DefineTerm" . "dt")

491 ;; ("Description" . "dd")

492 ;; ("dd") ("dt") ("li")

493 )

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

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

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

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

498

499 (defvar yahtml-current-completion-type nil

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

501

502 (defvar yahtml-struct-name-regexp

503 (concat

504 "\\<\\("

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

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

507 "\\)\\b")

508 "Regexp of structure beginning.")

509

510 (defvar yahtml-closable-regexp

511 (concat

512 "\\<\\("

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

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

515 "\\)\\b")

516 "Regexp of any closable elemnts.")

517

518 (defvar yahtml-indent-listing-constant t

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

520 T for static indentation depth")

521

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

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

524

525

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

527 (cond

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

529 buffer-file-name)

530 (let ((dir default-directory)

531 charset af ext (ldir "")

532 line

533 (case-fold-search t)

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

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

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

537 (while (and dir

538 (not (string= dir ldir))

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

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

541 (if (file-exists-p af)

542 (save-excursion

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

544 (save-excursion

545 (goto-char (point-min))

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

547 (setq line (buffer-substring

548 (point-beginning-of-line)

549 (point-end-of-line))

550 dir nil)))

551 (kill-buffer (current-buffer))))

552 (if dir

553 (setq ldir dir

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

555 dir (file-name-directory dir))))

556 line))

557 (t nil)))

558

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

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

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

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

563 (case-fold-search t)

564 line

565 charset)

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

567 (progn

568 (string-match ptn line)

569 (setq charset

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

571 (cond

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

573 (setq charset 2))

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

575 (setq charset 3))

576 ((string-match "shift_jis" charset)

577 (setq charset 1))

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

579 (setq charset 4))

580 (t (setq charset nil)))

581 (setq dir "")))

582 (if (featurep 'mule)

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

584 charset))

585

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

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

588 x index-list)

589 ;;s/\\s *$//;

590 (if line

591 (progn

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

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

594 (while (string< "" line)

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

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

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

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

599 line "")))

600 (or (nreverse index-list)

601 (if (listp yahtml-directory-index)

602 yahtml-directory-index

603 (list yahtml-directory-index)))))))

604

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

606 (defun yahtml-mode ()

607 (interactive)

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

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

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

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

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

613 (cond

614 ((null coding) nil)

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

616 (setq buffer-file-coding-system

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

618 (save-excursion

619 (goto-char (point-min))

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

621 coding)))

622 ((featurep 'mule)

623 (set-file-coding-system coding))

624 ((boundp 'NEMACS)

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

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

627 (setq major-mode 'yahtml-mode

628 mode-name "yahtml"

629 YaTeX-current-file-name (file-name-nondirectory

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

631 local-abbrev-table yahtml-mode-abbrev-table)

632 (mapcar

633 (function (lambda (x)

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

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

636 (boundp (cdr x)))

637 (symbol-value (cdr x))

638 (cdr x)))))

639 '((YaTeX-ec . "")

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

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

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

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

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

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

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

647 (paragraph-start . yahtml-paragraph-start)

648 (paragraph-separate . yahtml-paragraph-separate)

649 (comment-start . "")

650 (comment-start-skip . comment-start)

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

652

653 (if yahtml-use-font-lock

654 (progn

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

656 (or (featurep 'xemacs)

657 (progn

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

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

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

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

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

663 (font-lock-fontify-buffer)))))

664 ;; +dnd for X11 w/ emacs23+

665 (and window-system (featurep 'dnd)

666 (set (make-local-variable 'dnd-protocol-alist)

667 (cons (cons "^\$file\\|https?\$:" 'yahtml-dnd-handler)

668 dnd-protocol-alist)))

669

670 (set-syntax-table yahtml-syntax-table)

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

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

673 (yahtml-css-scan-styles)

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

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

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

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

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

679

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

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

682 font-lock-defaults)

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

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

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

686

687 (defun yahtml-version ()

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

689 (interactive)

690 (message

691 (concat "Yet Another HTML-mode "

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

693 " Revision "

694 yahtml-revision-number)))

695

696 (defun yahtml-quit ()

697 (interactive)

698 (and yahtml-mode-old-mode

699 (fboundp yahtml-mode-old-mode)

700 (funcall yahtml-mode-old-mode)))

701

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

703 (cond

704 ((featurep 'xemacs)

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

706 (set keymap nil)

707 (mapcar

708 (function

709 (lambda (bind)

710 (setq bind (cdr bind))

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

712 (setcar (cdr bind) 'progn))

713 (if (stringp (car (cdr bind)))

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

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

716 (symbol-value keymap))))))

717 bindlist)

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

719 (t

720 (mapcar

721 (function

722 (lambda (bind)

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

724 bindlist))))

725

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

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

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

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

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

731

732 ;;; Variables for mosaic url history

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

734 (defvar yahtml-urls-private nil)

735 (defvar yahtml-urls-local nil)

736

737 (cond

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

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

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

741 (YaTeX-define-menu

742 'yahtml-menu-map-sectioning

743 (nreverse

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

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

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

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

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

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

750 )))

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

752 (YaTeX-define-menu

753 'yahtml-menu-map-logical

754 (nreverse

755 '((em "Embolden" .

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

757 (dfn "Define a word" .

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

759 (cite "Citation" .

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

761 (code "Code" .

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

763 (kbd "Keyboard" .

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

765 (samp "Sample display" .

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

767 (strong "Strong" .

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

769 (VAR "Variable notation" .

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

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

772 (YaTeX-define-menu

773 'yahtml-menu-map-typeface

774 (nreverse

775 '((b "Bold" .

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

777 (i "Italic" .

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

779 (tt "Typewriter" .

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

781 (u "Underlined" .

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

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

784 (YaTeX-define-menu

785 'yahtml-menu-map-listing

786 (nreverse

787 '((ul "Unordered" .

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

789 (ol "Ordered" .

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

791 (dl "Definition" .

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

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

794 (YaTeX-define-menu

795 'yahtml-menu-map-item

796 (nreverse

797 '((li "Simple item" .

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

799 (dt "Define term" .

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

801 (dd "Description of term" .

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

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

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

805 (YaTeX-define-menu

806 'yahtml-menu-map

807 (nreverse

808 (list

809 (cons (list 'sect "Sectioning")

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

811 (cons (list 'list "Listing")

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

813 (cons (list 'item "Item")

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

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

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

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

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

819 (if (featurep 'xemacs)

820 (add-hook 'yahtml-mode-hook

821 '(lambda ()

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

823 (progn

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

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

826

827 ;;; ----------- Completion ----------

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

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

830 "Insert <cmd> ... </cmd>."

831 (interactive "P")

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

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

834 (cmd

835 (or env

836 (YaTeX-cplread-with-learning

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

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

839 (bolp (save-excursion

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

841 (cc (current-column)))

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

843 (setq yahtml-last-begend

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

845 yahtml-last-begend))

846 (setq cmd yahtml-last-begend)

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

848 (if region

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

850 ;; to enable continuous regioning by another environment

851 (let ((beg (region-beginning))

852 (end (region-end))

853 (addin (yahtml-addin cmd)))

854 (save-excursion

855 (goto-char end)

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

857 (goto-char beg)

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

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

860 (save-excursion

861 (insert "\n")

862 (indent-to-column cc)

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

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

865 (newline)

866 (yahtml-intelligent-newline nil))

867 (yahtml-indent-line))))

868

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

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

871 (interactive)

872 (yahtml-insert-begend t))

873

874

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

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

877 (interactive)

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

879 (or form

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

881 (setq form

882 (YaTeX-cplread-with-learning

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

884 'yahtml-form-table 'yahtml-user-form-table

885 'yahtml-tmp-form-table))))

886 (let ((p (point)) q)

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

888 (setq yahtml-last-form form)

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

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

891 ;;(indent-relative-maybe)

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

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

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

895

896 (defun yahtml-read-css (alist)

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

898 (minibuffer-completion-table alist))

899 (read-from-minibuffer

900 (substitute-command-keys

901 (if YaTeX-japan

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

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

904 nil YaTeX-minibuffer-completion-map nil)))

905

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

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

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

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

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

911 (defun yahtml-newpage (file ov)

912 "Create newpage via newpage script"

913 (interactive

914 (list

915 (let (insert-default-directory)

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

917 current-prefix-arg))

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

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

920 (insert (substring

921 (YaTeX-command-to-string

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

923 0 -1)))

924

925 ;;; ---------- Add-in ----------

926 (defun yahtml-addin (form)

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

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

929 (concat

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

931 (not (equal (YaTeX-last-key) ?\C-j))

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

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

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

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

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

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

938 (string< "" s))

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

940 ""))))

941

942 (defvar yahtml-completing-buffer nil)

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

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

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

946 (let (list end)

947 (save-excursion

948 (set-buffer yahtml-completing-buffer)

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

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

951 (save-excursion

952 (goto-char (point-min))

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

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

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

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

957 (setq end (match-end 0))

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

959 (yahtml-on-assignment-p)

960 (progn

961 (goto-char end)

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

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

964 (setq list (cons

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

966 list))))

967 list))))

968

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

970 (if yahtml-url-completion-map nil

971 (setq yahtml-url-completion-map

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

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

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

975

976 (defun yahtml-complete-url ()

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

978 (interactive)

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

980 (lim (YaTeX-minibuffer-begin))

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

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

983 (cond

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

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

986 listfunc (list 'lambda nil

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

988 beg min))

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

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

991 (progn

992 (setq path (substring initial 0 beg))

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

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

995 (setq initial (substring initial beg))

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

997 cmpl (try-completion initial labels)

998 listfunc (list 'lambda ()

999 (list 'all-completions

1000 initial (list 'quote labels)))

1001 beg (+ min beg)))

1002 (t

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

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

1005 initial))

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

1007 file (file-name-nondirectory path)

1008 initial file

1009 cmpl (file-name-completion file dir)

1010 listfunc (list 'lambda nil

1011 (list 'file-name-all-completions

1012 file dir))

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

1014 (cond

1015 ((stringp cmpl)

1016 (if (string= initial cmpl)

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

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

1019 (princ

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

1021 (delete-region (point) beg)

1022 (insert cmpl)))

1023 ((null cmpl)

1024 (ding))

1025 ((eq t cmpl)

1026 (save-excursion

1027 (unwind-protect

1028 (progn

1029 (goto-char p)

1030 (insert " [Sole completion]"))

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

1032

1033 ;

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

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

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

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

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

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

1040 ;

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

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

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

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

1045 (defvar yahtml-unsafe-chars-regexp

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

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

1048 ;

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

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

1051 ;

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

1053 ; "$" | ","

1054 (defvar yahtml-unreserved-chars-regexp

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

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

1057 Not used yet.")

1058

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

1060 "Translate reserved chars to URL encoded string."

1061 (let ((p 0) (target "")

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

1063 (cond

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

1065 (t

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

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

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

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

1070 (setq target (concat target

1071 (substring str 0 p)

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

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

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

1075 (concat target str)))))

1076

1077 (defun yahtml-unescape-string (str)

1078 "Untranslate reserved URL-encoded string."

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

1080 (unwind-protect

1081 (progn

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

1083 (setq target (concat target

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

1085 p (match-end 0)

1086 c (YaTeX-hex (substring

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

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

1089 (concat target (substring str p)))

1090 (store-match-data md))))

1091

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

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

1094 (interactive "r")

1095 (save-excursion

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

1097 (goto-char beg)

1098 (while (and (< (point) e)

1099 (re-search-forward

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

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

1102 (sit-for 0)

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

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

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

1106 ; (unwind-protect

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

1108 ; (save-excursion

1109 ; (backward-char 1)

1110 ; (delete-backward-char 4))

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

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

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

1114 (progn

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

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

1117 (set-marker e nil))))

1118 ;; ab%defgls/.|

1119

1120 (defun yahtml:a ()

1121 "Add-in function for <a>"

1122 (let ((href ""))

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

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

1125 href (yahtml-escape-chars-string

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

1127 (prog1

1128 (concat (yahtml-make-optional-argument

1129 "href" href)

1130 (yahtml-make-optional-argument

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

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

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

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

1135 (YaTeX-update-table

1136 (list href)

1137 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1138

1139 (defvar yahtml-parameters-completion-alist

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

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

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

1143 ("src" . file) ("file" . file)

1144 ("background" . file)

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

1146 ("method" ("POST") ("GET"))

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

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

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

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

1151 ("http-equiv" ("Refresh"))))

1152

1153 (defvar yahtml-link-types-alist

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

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

1156 ("subsection") ("appendix") ("help") ("bookmark")))

1157

1158 (defvar yahtml-content-types-alist

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

1160 ("text/sgml") ("text/xml")

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

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

1163 ("application/java")

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

1165 "Alist of content-types")

1166

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

1168 (let* ((alist

1169 (cdr-safe (assoc (downcase par)

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

1171 (prompt (concat par ": "))

1172 v)

1173 (cond

1174 ((eq alist 'file)

1175 (let ((insert-default-directory))

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

1177 ((eq alist 'command)

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

1179 (read-shell-command prompt)

1180 (read-string prompt)))

1181 ((and alist (symbolp alist))

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

1183 (alist

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

1185 (t

1186 (read-string prompt default)))))

1187

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

1189 "Make optional argument string."

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

1191 ""

1192 (concat " "

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

1194 "=\"" arg "\"")))

1195

1196 (defun yahtml:html ()

1197 "Add-in for <html>"

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

1199 (yahtml-make-optional-argument

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

1201

1202 (defun yahtml:head ()

1203 "Add-in for <head>"

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

1205 "")

1206

1207 (defun yahtml:body ()

1208 "Add-in function for <body>"

1209 (cond

1210 (yahtml-html4-strict nil)

1211 (t

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

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

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

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

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

1217 (concat

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

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

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

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

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

1223

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

1225 "Make CSS property definitions in style attribute."

1226 (mapconcat

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

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

1229 (delq nil proplist)

1230 " "))

1231

1232 (defun yahtml:img ()

1233 "Add-in function for <img>"

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

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

1236 alt

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

1238 (l yahtml-prefer-upcase-attributes)

1239 info width height bytes comments)

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

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

1242 (car info)

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

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

1245 bytes (car (cdr (cdr info)))

1246 comments (nth 4 info)))

1247 (if info

1248 (setq alt

1249 (YaTeX-replace-formats

1250 yahtml:img-default-alt-format

1251 (list (cons "x" width)

1252 (cons "y" height)

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

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

1255 (cons "c" (car comments))))))

1256

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

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

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

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

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

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

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

1264 (if yahtml-html4-strict

1265 (yahtml-make-optional-argument

1266 "style"

1267 (if (or brd alg)

1268 (yahtml-make-style-parameter

1269 (list

1270 (if (string< "" alg)

1271 (cons "align" alg))

1272 (if (string< "" brd)

1273 (cons "border"

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

1275 (concat

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

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

1278

1279 (defun yahtml-file-truename (file)

1280 (cond

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

1282 (t (let ((new file))

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

1284 (not (equal new file)))

1285 (setq file new))

1286 file))))

1287

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

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

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

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

1292 (let ((mlt 1)

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

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

1295 (value 0))

1296 (while (> length 0)

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

1298 pos (+ pos direc)

1299 mlt (* mlt 256)

1300 length (1- length)))

1301 value))

1302

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

1304 "Return the information on the image file FILE.

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

1306 (save-excursion

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

1308 width height bytes depth comment

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

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

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

1312 (seekpoint 1)

1313 c1 c2 c3 c4 beg end

1314 (case-fold-search nil))

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

1316 (set-buffer tmpbuf)

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

1318 (erase-buffer)

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

1320 (unwind-protect

1321 (progn

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

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

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

1325 (YaTeX-insert-file-contents

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

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

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

1329 c2 (char-after 2)

1330 c3 (char-after 3)

1331 c4 (char-after 4))

1332 (cond

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

1334 ;;JPEG images need JPEG markers inspection

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

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

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

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

1339 (catch 'exit

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

1341 (cond

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

1343 ;maybe corrupted, exit from loop

1344 (throw 'exit t))

1345 ((memq

1346 (char-after (1+ seekpoint))

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

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

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

1350 ;;found!

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

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

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

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

1355 ;; JPEG comment area

1356 (setq beg (+ seekpoint 2 2)

1357 end (+ seekpoint

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

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

1360 (t ;other markers

1361 nil)) ;just skip it

1362 (setq seekpoint (+ seekpoint 2)

1363 seekpoint (+ seekpoint

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

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

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

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

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

1369 height (yahtml-hex-value 20 4)

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

1371 ((looking-at "GIF8")

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

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

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

1375 ((looking-at "BM")

1376 ;;# OS/2, Windoze BMP files

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

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

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

1380 (cond

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

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

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

1384 (t

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

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

1387 (message "")

1388 (kill-buffer tmpbuf))

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

1390

1391 (defun yahtml:form ()

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

1393 (concat

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

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

1396 "\""

1397 (yahtml-make-optional-argument

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

1399 (completing-read

1400 "Enctype: "

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

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

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

1404

1405 (defun yahtml:select ()

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

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

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

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

1410

1411 (defun yahtml:ol ()

1412 "Add-in function for <ol>"

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

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

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

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

1417 (concat

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

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

1420 (defun yahtml:ul ()

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

1422 (defun yahtml:dl ()

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

1424 (defun yahtml:dt ()

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

1426

1427 (defun yahtml:p ()

1428 (if yahtml-html4-strict nil

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

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

1431

1432 (defvar yahtml-input-types

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

1434 ("reset") ("image") ("hidden") ("file")))

1435

1436 (defun yahtml:input ()

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

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

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

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

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

1442 yahtml-input-types nil t)

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

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

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

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

1447 (concat

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

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

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

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

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

1453

1454 (defun yahtml:textarea ()

1455 "Add-in function for `textarea'"

1456 (interactive)

1457 (let (name rows cols)

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

1459 cols (read-string "Columns: ")

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

1461 (concat

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

1463 "\"" name "\"")

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

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

1466

1467 (defun yahtml:table ()

1468 "Add-in function for `table'"

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

1470 (a (yahtml-read-parameter

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

1472 (if yahtml-html4-strict

1473 (yahtml-make-optional-argument

1474 "style"

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

1476 (yahtml-make-style-parameter

1477 (append

1478 (if (string< "" b)

1479 (list

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

1481 (cons "border-collapse" "collapse")))

1482 (if (string< "" a)

1483 (cond

1484 ((string-match "right" a)

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

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

1487 ((string-match "center" a)

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

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

1490 (concat

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

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

1493

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

1495 (defun yahtml:caption ()

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

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

1498 (if yahtml-html4-strict

1499 (yahtml-make-optional-argument

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

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

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

1503

1504 (defun yahtml:font ()

1505 "Add-in function for `font'"

1506 (concat

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

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

1509

1510 (defun yahtml:style ()

1511 "Add-in function for `style'"

1512 (yahtml-make-optional-argument

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

1514

1515 (defun yahtml:script ()

1516 "Add-in function for `script'"

1517 (concat

1518 (yahtml-make-optional-argument

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

1520 (yahtml-make-optional-argument

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

1522

1523 (defun yahtml:tr ()

1524 "Add-in function for `tr'"

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

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

1527 "")

1528

1529 (defun yahtml:link ()

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

1531 (let (rel rev type href)

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

1533 (cond

1534 ((equal rel "")

1535 (concat (yahtml-make-optional-argument

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

1537 (yahtml-make-optional-argument

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

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

1540 )))

1541 ((string-match "stylesheet" rel)

1542 (concat

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

1544 (yahtml-make-optional-argument

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

1546 (progn

1547 (setq href

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

1549 (if (string< "" href)

1550 (progn

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

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

1553 (setq yahtml-css-class-alist

1554 (yahtml-css-collect-classes-file

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

1556 (message "")

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

1558 (t

1559 (concat

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

1561 (yahtml-make-optional-argument

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

1563 (yahtml-make-optional-argument

1564 "href"

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

1566

1567 (defvar yahtml:meta-names

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

1569

1570 (defun yahtml:meta ()

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

1572 "name"

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

1574 http-equiv content)

1575 (if (string= "" name)

1576 (if (string-match

1577 "Content-type"

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

1579 "http-equiv"

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

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

1582 "See docs/qanda")

1583 (concat http-equiv

1584 (yahtml-make-optional-argument

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

1586 (concat

1587 name

1588 (yahtml-make-optional-argument

1589 "content"

1590 (cond

1591 ((string-match "date" name)

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

1593 ((string-match "author" name)

1594 (read-string "Author: "

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

1596 (user-full-name)

1597 (user-login-name))))

1598 ((string-match "GENERATOR" name)

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

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

1601 (message "Thank you!"))

1602 content)

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

1604

1605 (defun yahtml:br ()

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

1607

1608 (defun yahtml:object ()

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

1610 data classid)

1611 (cond

1612 ((string-match "java" codetype)

1613 (let ((completion-ignored-extensions

1614 ;;any extensions except ".class"

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

1616 (setq classid (concat "java:"

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

1618 (concat

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

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

1621 (yahtml-make-optional-argument

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

1623 (yahtml-make-optional-argument

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

1625 (yahtml-make-optional-argument

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

1627 (t

1628 ""))))

1629

1630 (defun yahtml:abbr ()

1631 "Add-in function for abbr."

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

1633

1634 (defun yahtml:button ()

1635 (concat

1636 (yahtml-make-optional-argument

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

1638 (yahtml-make-optional-argument

1639 "type" (yahtml-read-parameter

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

1641 (yahtml-make-optional-argument

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

1643

1644 ;;; ---------- Simple tag ----------

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

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

1647 (interactive "P")

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

1649 (or tag

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

1651 (setq tag

1652 (YaTeX-cplread-with-learning

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

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

1655 'yahtml-typeface-table 'yahtml-user-typeface-table

1656 'yahtml-tmp-typeface-table))))

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

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

1659 (setq yahtml-last-typeface-cmd tag

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

1661 (if region-mode

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

1663 (save-excursion

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

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

1666 (exchange-point-and-mark)

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

1668 (message "No mark set now"))

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

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

1671

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

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

1674 (interactive)

1675 (yahtml-insert-tag t tag))

1676

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

1678 (defun yahtml-insert-single (cmd)

1679 "Insert <CMD>."

1680 (interactive

1681 (list

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

1683 (YaTeX-cplread-with-learning

1684 (format "Command%s: "

1685 (if yahtml-last-single-cmd

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

1687 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1690 (setq yahtml-last-single-cmd

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

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

1693 yahtml-last-single-cmd))

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

1695 cmd

1696 (yahtml-addin cmd)

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

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

1699 " /" "")))

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

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

1702

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

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

1705 (interactive "P")

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

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

1708

1709 (defun yahtml-insert-amps (arg)

1710 "Insert char-entity references via ampersand"

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

1712 (interactive "P")

1713 (let*((mess "") c

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

1715 yahtml-entity-reference-chars-alist))

1716 (l list))

1717 (while l

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

1719 l (cdr l)))

1720 (message "Char-entity reference: %s SPC=& RET=&; BS=%s Other=&#..;"

1721 mess (if YaTeX-japan "直前の文字" "Preceding-Char"))

1722 (setq c (read-char))

1723 (cond

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

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

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

1727 (insert "&;")

1728 (forward-char -1))

1729 ((equal c ? )

1730 (insert ?&))

1731 ((and (memq c '(127 8))

1732 (setq c (preceding-char))

1733 (delete-backward-char 1)

1734 nil)) ;Fall through to the next 't block

1735 (t (insert (format "&#x%x;" c))))))

1736

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

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

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

1740

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

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

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

1744

1745 ;;; ---------- Jump ----------

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

1747 "Check if point is on href clause."

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

1749 (save-excursion

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

1751 (save-excursion

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

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

1754 (setq e (point)))

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

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

1757 (search-forward "href" e t)

1758 (search-forward "=" e t)

1759 (progn

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

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

1762 (< p (match-end 0))

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

1764

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

1766 (cond

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

1768 (set-process-buffer proc nil))

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

1770 (let ((cb (current-buffer)))

1771 (set-buffer (process-buffer proc))

1772 (goto-char (point-min))

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

1774 (progn

1775 (message "Starting netscape...")

1776 (start-process

1777 "browser" (process-buffer proc)

1778 shell-file-name yahtml-shell-command-option

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

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

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

1782 (set-buffer cb)))))

1783

1784 (defvar yahtml-browser-process nil)

1785

1786 (defun yahtml-browse-html (href)

1787 "Call WWW Browser to see HREF."

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

1789 (cond

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

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

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

1799 'yahtml-netscape-sentinel))

1800 ((and (string-match

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

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

1803 (if (get-buffer pb)

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

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

1806 (set-process-sentinel

1807 (setq yahtml-browser-process

1808 (start-process

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

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

1811 'yahtml-netscape-sentinel))

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

1813 (w3-fetch href))

1814 ((stringp yahtml-www-browser)

1815 (if (and yahtml-browser-process

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

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

1818 (setq yahtml-browser-process

1819 (start-process

1820 "browser" "* WWW Browser *"

1821 shell-file-name yahtml-shell-command-option

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

1823 (t

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

1825

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

1827 "Go to corresponding name."

1828 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1829 (if href

1830 (cond

1831 ((string-match "^\$ht\\|f\$tps?:" href)

1832 (yahtml-browse-html href))

1833 (t (setq file (substring href 0 (string-match "#" href)))

1834 (if (string-match "#" href)

1835 (setq name (substring href (1+ (string-match "#" href)))))

1836 (if (string< "" file)

1837 (progn

1838 (if (string-match "/$" file)

1839 (or (catch 'dirindex

1840 (mapcar

1841 (function

1842 (lambda (f)

1843 (if (file-exists-p (concat file f))

1844 (throw 'dirindex

1845 (setq file (concat file f))))))

1846 (yahtml-get-directory-index))

1847 nil)

1848 (setq file (concat file yahtml-directory-index))))

1849 (if (string-match "^/" file)

1850 (setq file (yahtml-url-to-path file)))

1851 (if other (YaTeX-switch-to-buffer-other-window file)

1852 (YaTeX-switch-to-buffer file))

1853 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1854 (if name

1855 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1856 t)))))

1857

1858 (defun yahtml-jump-to-name (name)

1859 "Jump to html's named tag."

1860 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1861 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1862 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1863 (message "Named tag `%s' not found" (substring href 1))))

1864

1865 (defun yahtml-on-begend-p (&optional p)

1866 "Check if point is on begend clause."

1867 (let ((p (or p (point))) cmd (case-fold-search t))

1868 (save-excursion

1869 (goto-char p)

1870 (if (equal (char-after (point)) ?<) (forward-char 1))

1871 (if (and (re-search-backward "<" nil t)

1872 (looking-at

1873 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1874 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1875 (condition-case nil

1876 (forward-list 1)

1877 (error nil))

1878 (< p (point)))

1879 (YaTeX-match-string 1)))))

1880

1881 (defun yahtml-goto-corresponding-begend (&optional noerr)

1882 "Go to corresponding opening/closing tag.

1883 Optional argument NOERR causes no error for unballanced tag."

1884 (let ((cmd (yahtml-on-begend-p)) m0

1885 (p (point)) (case-fold-search t) func str (nest 0))

1886 (cond

1887 (cmd

1888 (setq m0 (match-beginning 0))

1889 (if (= (aref cmd 0) ?/) ;on </cmd> line

1890 (setq cmd (substring cmd 1)

1891 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1892 func 're-search-backward)

1893 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1894 func 're-search-forward))

1895 (while (and (>= nest 0) (funcall func str nil t))

1896 (if (equal m0 (match-beginning 0))

1897 nil

1898 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1899 (if (< nest 0)

1900 (goto-char (match-beginning 0))

1901 (funcall

1902 (if noerr 'message 'error)

1903 "Corresponding tag of `%s' not found." cmd)

1904 (goto-char p)

1905 nil))

1906 (t nil))))

1907

1908 (defun yahtml-current-tag ()

1909 "Return the current tag name including #exec and #include."

1910 (save-excursion

1911 (let ((p (point)) b tag)

1912 (or (bobp)

1913 (looking-at "<")

1914 (progn (skip-chars-backward "^<") (forward-char -1)))

1915 (setq b (point))

1916 (skip-chars-forward "<")

1917 (setq tag (YaTeX-buffer-substring

1918 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1919 (goto-char b)

1920 (forward-list 1)

1921 (and (< p (point)) tag))))

1922

1923 (defun yahtml-get-attrvalue (attr)

1924 "Extract current tag's attribute value from buffer."

1925 (let (e (case-fold-search t))

1926 (save-excursion

1927 (or (looking-at "<")

1928 (progn (skip-chars-backward "^<") (backward-char 1)))

1929 (setq e (save-excursion (forward-list 1) (point)))

1930 (if (and

1931 (re-search-forward (concat "\\b" attr "\\b") e t)

1932 (progn (skip-chars-forward " \t\n=")

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

1934 (YaTeX-match-string 1)))))

1935

1936 (defun yahtml-goto-corresponding-img ()

1937 "View image on point"

1938 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1939 (if (and tag

1940 (string-match "img" tag)

1941 (setq image

1942 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1943 (progn

1944 (message "Invoking %s %s..." yahtml-image-viewer image)

1945 (start-process

1946 "Viewer" " * Image Viewer *"

1947 shell-file-name yahtml-shell-command-option ;"-c"

1948 (concat yahtml-image-viewer " " image))

1949 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1950

1951 (defun yahtml-goto-corresponding-source (&optional other)

1952 "Goto applet's or script's source."

1953 (let ((env (yahtml-current-tag)) s (p (point)))

1954 (cond

1955 ((string-match "applet" env)

1956 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1957 (progn

1958 (setq s (YaTeX-match-string 1)

1959 s (concat

1960 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1961 ".java"))

1962 (if other (YaTeX-switch-to-buffer-other-window s)

1963 (YaTeX-switch-to-buffer s))

1964 s) ;return source file name

1965 (message "No applet source specified")

1966 (sit-for 1)

1967 nil))

1968 ((string-match "script" env)

1969 (if (setq s (yahtml-get-attrvalue "src"))

1970 (progn

1971 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1972 'YaTeX-switch-to-buffer)

1973 (yahtml-url-to-path s))

1974 s)))

1975 ((string-match "!--#include" env)

1976 (cond

1977 ((setq s (yahtml-get-attrvalue "file")) ;

1978 (if other (YaTeX-switch-to-buffer-other-window s)

1979 (YaTeX-switch-to-buffer s))

1980 s)

1981 ((setq s (yahtml-get-attrvalue "virtual"));

1982 (setq s (yahtml-url-to-path s))

1983 (if other (YaTeX-switch-to-buffer-other-window s)

1984 (YaTeX-switch-to-buffer s))

1985 s)))

1986 ((and (string-match "!--#exec" env)

1987 (setq s (yahtml-get-attrvalue "cmd")))

1988 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1989 (let ((b " *yahtmltmp*")) ;peek a little

1990 (unwind-protect

1991 (progn

1992 (set-buffer (get-buffer-create b))

1993 (YaTeX-insert-file-contents s nil 0 100)

1994 (if (looking-at "#!")

1995 (if other (YaTeX-switch-to-buffer-other-window s)

1996 (YaTeX-switch-to-buffer s))))

1997 (kill-buffer (get-buffer b)))

1998 (get-file-buffer s))))))

1999

2000 (defun yahtml-goto-corresponding-* (&optional other)

2001 "Go to corresponding object."

2002 (interactive "P")

2003 (cond

2004 ((yahtml-goto-corresponding-href other))

2005 ((yahtml-goto-corresponding-img))

2006 ((yahtml-goto-corresponding-source other))

2007 ((yahtml-goto-corresponding-begend))

2008 (t (message "I don't know where to go."))))

2009

2010 (defun yahtml-goto-corresponding-*-other-window ()

2011 "Go to corresponding object."

2012 (interactive)

2013 (yahtml-goto-corresponding-* t))

2014

2015 (defun yahtml-visit-main ()

2016 "Go to parent file from where you visit current file."

2017 (interactive)

2018 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2019

2020 ;;; ---------- killing ----------

2021 (defun yahtml-kill-begend (&optional whole)

2022 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2023 (if tag

2024 (save-excursion

2025 (or (looking-at "<")

2026 (progn (skip-chars-backward "^<") (forward-char -1)))

2027 (setq p (point))

2028 (yahtml-goto-corresponding-begend)

2029 (or (looking-at "<")

2030 (progn (skip-chars-backward "^<") (forward-char -1)))

2031 (if (< (point) p) ;if on the opening tag

2032 (progn (setq q p p (point))

2033 (goto-char q))

2034 (setq q (point))) ;now q has end-line's (point)

2035 (if (not whole)

2036 (kill-region

2037 (progn (skip-chars-backward " \t")

2038 (if (setq bbolp (bolp)) (point) q))

2039 (progn (forward-list 1)

2040 (setq r (point))

2041 (skip-chars-forward " \t")

2042 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2043 (goto-char p)

2044 (skip-chars-backward " \t")

2045 (if (not whole)

2046 (progn

2047 (kill-append

2048 (buffer-substring

2049 (setq p (if (setq bbolp (bolp)) (point) p))

2050 (setq q (progn

2051 (forward-list 1)

2052 (setq r (point))

2053 (skip-chars-forward " \t")

2054 (if (and bbolp (eolp) (not (eobp)))

2055 (1+ (point))

2056 r))))

2057 t)

2058 (delete-region p q))

2059 (kill-region

2060 (if (bolp) (point) p)

2061 (progn (goto-char q)

2062 (forward-list 1)

2063 (setq r (point))

2064 (skip-chars-forward " \t")

2065 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2066 tag))))

2067

2068 (defun yahtml-kill-* (whole)

2069 "Kill current position's HTML tag (set)."

2070 (interactive "P")

2071 (cond

2072 ((yahtml-kill-begend whole))))

2073

2074

2075 ;;; ---------- changing ----------

2076 (defun yahtml-on-assignment-p ()

2077 "Return if current point is on parameter assignment.

2078 If so, return parameter name, otherwise nil.

2079 This function should be able to treat white spaces in value, but not yet."

2080 (let ((p (point)))

2081 (save-excursion

2082 (put 'yahtml-on-assignment-p 'region nil)

2083 (skip-chars-backward "^ \t\n")

2084 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2085 (< p (match-end 0))

2086 (>= p (1- (match-beginning 2)))

2087 (put 'yahtml-on-assignment-p 'region

2088 (cons (match-beginning 2) (match-end 2)))

2089 (YaTeX-match-string 1)))))

2090

2091 (defun yahtml-change-begend ()

2092 (let ((tag (yahtml-on-begend-p))

2093 (completion-ignore-case t)

2094 (case-fold-search t)

2095 (p (point)) (q (make-marker))

2096 (default (append yahtml-env-table yahtml-typeface-table))

2097 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2098 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2099 href b1 e1 attr new css)

2100 (cond

2101 (tag

2102 (cond

2103 ((and (string-match "^a$" tag)

2104 (save-excursion

2105 (and

2106 (re-search-backward "<a\\b" nil t)

2107 (progn

2108 (goto-char (match-end 0))

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

2110 (setq b1 (point))

2111 (search-forward ">" nil t))

2112 (setq e1 (match-beginning 0))

2113 (goto-char b1)

2114 (re-search-forward "href\\s *=" e1 t)

2115 (>= p (point))

2116 (progn

2117 (goto-char (match-end 0))

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

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

2120 (< p (match-end 0)))))

2121 (setq b1 (match-beginning 1) e1 (match-end 1)

2122 yahtml-completing-buffer (current-buffer)

2123 ;; yahtml-urls-local is buffer-local, so we must put

2124 ;; that into yahtml-urls here

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

2126 href (read-from-minibuffer

2127 "Change href to: " "" yahtml-url-completion-map))

2128 (if (string< "" href)

2129 (progn

2130 ;;(setq href ;??

2131 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2132 (delete-region b1 e1)

2133 (goto-char b1)

2134 (insert href))))

2135 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2136 (if (and (equal attr "class") ;treat "class" attribute specially

2137 (setq css (yahtml-css-get-element-completion-alist tag)))

2138

2139 (setq new (yahtml-read-css css))

2140 ;;other than "class", read parameter normally

2141 (setq new (yahtml-read-parameter attr)))

2142 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2143 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2144 (insert new))

2145 (t

2146 (save-excursion

2147 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2148 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2149 (skip-chars-forward "^A-Za-z")

2150 (set-marker q (point))

2151 (setq p (point))

2152 (yahtml-goto-corresponding-begend)

2153 (or (= (char-after (point)) ?<)

2154 (skip-chars-backward "^<"))

2155 (skip-chars-forward "^A-Za-z")

2156 (if (= (char-after (1- (point))) ?/)

2157 (progn

2158 (set-marker q (point))

2159 (goto-char p)))

2160 (setq tag (let ((completion-ignore-case t))

2161 (YaTeX-cplread-with-learning

2162 (format "Change `%s' to(default %s): "

2163 tag yahtml-last-begend)

2164 'default 'user 'tmp)))

2165 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2166 (if (string= "" tag) (setq tag yahtml-last-begend))

2167 (setq yahtml-last-begend

2168 (or (cdr (assoc tag yahtml-env-table)) tag)

2169 tag yahtml-last-begend)

2170 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2171 (insert (format "%s%s" tag (yahtml-addin tag)))

2172 (goto-char q)

2173 (set-marker q nil)

2174 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2175 (insert tag))))

2176 t))))

2177

2178 (defun yahtml-change-command ()

2179 (let ((p (point)) (case-fold-search t) cmd par new

2180 (beg (make-marker)) (end (make-marker)))

2181 (skip-chars-backward "^<")

2182 (if (and

2183 (looking-at yahtml-command-regexp)

2184 (progn

2185 (set-marker beg (match-beginning 0))

2186 (set-marker end (match-end 0))

2187 t) ;for further work

2188 (progn

2189 (forward-char -1)

2190 (condition-case nil

2191 (forward-list 1)

2192 (error nil))

2193 (< p (point))))

2194 (progn

2195 (goto-char p)

2196 (if (setq par (yahtml-on-assignment-p))

2197 (progn

2198 (setq new (yahtml-read-parameter par))

2199 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2200 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2201 (setq new

2202 (YaTeX-cplread-with-learning

2203 "Change form to: "

2204 'yahtml-form-table 'yahtml-user-form-table

2205 'yahtml-tmp-form-table)))

2206 (delete-region beg end)

2207 (goto-char beg)

2208 (set-marker beg nil)

2209 (set-marker end nil)

2210 (insert new)

2211 t)

2212 (goto-char p)

2213 nil)))

2214

2215 (defun yahtml-change-* ()

2216 "Change current position's HTML tag (set)."

2217 (interactive)

2218 (cond

2219 ((yahtml-change-begend))

2220 ((yahtml-change-command))))

2221

2222 ;;; ---------- commenting ----------

2223

2224 (defun yahtml-comment-region (&optional uncom)

2225 "Comment out region or environment."

2226 (interactive)

2227 (let ((e (make-marker)) be beg p)

2228 (cond

2229 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2230 (setq be (yahtml-on-begend-p))

2231 (save-excursion

2232 (setq p (point))

2233 (if (string-match "^/" be)

2234 (setq beg (progn (forward-line 1) (point)))

2235 (setq beg (progn (beginning-of-line) (point))))

2236 (goto-char p)

2237 (yahtml-goto-corresponding-begend)

2238 (if (string-match "^/" be)

2239 (beginning-of-line)

2240 (forward-line 1))

2241 (set-marker e (point))

2242 ;(comment-region beg (point) (if uncom (list 4)))))

2243 ))

2244 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2245 (setq beg (region-beginning))

2246 (set-marker e (region-end))))

2247 (if yahtml-translate-hyphens-when-comment-region

2248 (let ((yahtml-entity-reference-chars-alist-default nil)

2249 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2250 yahtml-entity-reference-chars-regexp

2251 yahtml-entity-reference-chars-reverse-regexp)

2252 (yahtml-entity-reference-chars-setup)

2253 (funcall

2254 (if uncom 'yahtml-translate-reverse-region

2255 'yahtml-translate-region)

2256 beg e)))

2257 (comment-region beg e (if uncom (list 4)))

2258 (set-marker e nil)))

2259

2260 (defun yahtml-uncomment-region ()

2261 (interactive)

2262 (yahtml-comment-region t))

2263

2264 ;;; ---------- translate to entity references ----------

2265 (defvar yahtml-entity-reference-chars-alist-default

2266 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2267 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2268 "Default translation table from character to entity reference")

2269 (defvar yahtml-entity-reference-chars-alist nil

2270 "*Translation table from character to entity reference")

2271 (defvar yahtml-entity-reference-chars-regexp nil)

2272 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2273

2274 (defun yahtml-entity-reference-chars-setup ()

2275 (let ((list (append yahtml-entity-reference-chars-alist-default

2276 yahtml-entity-reference-chars-alist)))

2277 (setq yahtml-entity-reference-chars-regexp "["

2278 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2279 (while list

2280 (setq yahtml-entity-reference-chars-regexp

2281 (concat yahtml-entity-reference-chars-regexp

2282 (char-to-string (car (car list))))

2283 yahtml-entity-reference-chars-reverse-regexp

2284 (concat yahtml-entity-reference-chars-reverse-regexp

2285 (cdr (car list))

2286 (if (cdr list) "\\|")))

2287 (setq list (cdr list)))

2288 (setq yahtml-entity-reference-chars-regexp

2289 (concat yahtml-entity-reference-chars-regexp "]")

2290 yahtml-entity-reference-chars-reverse-regexp

2291 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2292

2293 (yahtml-entity-reference-chars-setup)

2294

2295 (defun yahtml-translate-region (beg end)

2296 "Translate inhibited literals."

2297 (interactive "r")

2298 (save-excursion

2299 (save-restriction

2300 (narrow-to-region beg end)

2301 (let ((ct (append yahtml-entity-reference-chars-alist

2302 yahtml-entity-reference-chars-alist-default)))

2303 (goto-char beg)

2304 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2305 ;(setq c (preceding-char))

2306 (replace-match

2307 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2308

2309 (defun yahtml-translate-reverse-region (beg end)

2310 "Translate entity references to literals."

2311 (interactive "r")

2312 (save-excursion

2313 (save-restriction

2314 (narrow-to-region beg end)

2315 (let ((ct (append yahtml-entity-reference-chars-alist

2316 yahtml-entity-reference-chars-alist-default))

2317 ec)

2318 (goto-char beg)

2319 (while (re-search-forward

2320 yahtml-entity-reference-chars-reverse-regexp nil t)

2321 ;(setq c (preceding-char))

2322 (setq ec (YaTeX-match-string 1))

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

2324 (insert (car (YaTeX-rassoc ec ct))))))))

2325

2326 (defun yahtml-inner-environment-but (exclude &optional quick)

2327 "Return the inner environment but matches with EXCLUDE tag."

2328 (let (e (case-fold-search t))

2329 (save-excursion

2330 (while (and (setq e (YaTeX-inner-environment quick))

2331 (string-match exclude e))

2332 (goto-char (get 'YaTeX-inner-environment 'point))))

2333 e))

2334

2335 (defun yahtml-untranslate-string (str)

2336 "Untranslate entity reference."

2337 (let ((md (match-data)) (left "") (right str) b0 ch

2338 (ct (append yahtml-entity-reference-chars-alist

2339 yahtml-entity-reference-chars-alist-default))

2340 (revrex yahtml-entity-reference-chars-reverse-regexp))

2341 (unwind-protect

2342 (progn

2343 (while (string< "" right)

2344 (cond

2345 ((string-match revrex right)

2346 (setq ch (YaTeX-rassoc

2347 (substring right (match-beginning 1) (match-end 1)))

2348 b0 (substring right 0 (match-beginning 0))

2349 right (substring right (match-end 0))

2350 left (concat left

2351 (substring right 0 (match-beginning 0))

2352 (char-to-string ch))))

2353 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2354 (setq ch (substring right (match-beginning 2) (match-end 2))

2355 b0 (substring right 0 (match-beginning 0))

2356 right (substring right (match-end 0))

2357 left (concat left

2358 b0

2359 (char-to-string

2360 (if (match-beginning 1)

2361 (YaTeX-hex ch)

2362 (string-to-number ch))))))

2363 (t (setq left (concat left right)

2364 right ""))))

2365 left)

2366 (store-match-data md))))

2367

2368 ;;; ---------- table-ize region ----------

2369 (defun yahtml-td-region (e delim beg end)

2370 "Enclose each item in a region with <td>..</td>.

2371 Interactive prefix argument consults enclosing element other than td."

2372 (interactive "P\nsDelimiter(s): \nr")

2373 (let ((e (cond

2374 ((null e) "td")

2375 ((stringp e) e)

2376 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2377 (ws "[ \t]")

2378 elm p i)

2379 (if (string= delim "") (setq delim " \t\n"))

2380 (setq delim (concat "[" delim "]+")

2381 elm (if (string= "thd" e)

2382 (cons "th" "td")

2383 (cons e e)))

2384 (save-excursion

2385 (save-restriction

2386 (narrow-to-region beg end)

2387 (goto-char (setq p (point-min)))

2388 (setq i 0 e (car elm))

2389 (while (re-search-forward delim nil t)

2390 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2391 (goto-char (match-beginning 0))

2392 (insert "</" e ">")

2393 (save-excursion

2394 (goto-char p)

2395 (insert "<" e ">"))

2396 (setq p (point))

2397 (while (and (not (eobp)) (looking-at ws))

2398 (delete-char 1))

2399 (if (looking-at delim) (delete-char 1)))

2400 (insert "<" e ">")

2401 (goto-char (point-max))

2402 (insert "</" e ">")))))

2403

2404 (defun yahtml-tr-region (e delim beg end)

2405 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2406 (interactive "P\nsDelimiter(s): \nr")

2407 (setq e (if (and e (listp e))

2408 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2409 "th")))

2410 (save-excursion

2411 (save-restriction

2412 (narrow-to-region (point) (mark))

2413 (goto-char (point-min))

2414 (while (not (eobp))

2415 (insert "<tr>")

2416 (yahtml-td-region e delim (point) (point-end-of-line))

2417 (end-of-line)

2418 (insert "</tr>")

2419 (forward-line 1)))))

2420

2421 ;;; ---------- filling ----------

2422 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2423 (defun yahtml-move-to-column (col &optional force)

2424 (beginning-of-line)

2425 (let ((ccol 0))

2426 (while (and (> col ccol) (not (eolp)))

2427 (if (eq (following-char) ?\<)

2428 (progn

2429 (while (and (not (eq (following-char) ?\>))

2430 (not (eolp)))

2431 (forward-char))

2432 (or (eolp) (forward-char)))

2433 (or (eolp) (forward-char))

2434 (if (eq (preceding-char) ?\t)

2435 (let ((wd (- 8 (% (+ ccol 8) 8))))

2436 (if (and force (< col (+ ccol wd)))

2437 (progn

2438 (backward-char 1)

2439 (insert-char ?\ (- col ccol))

2440 (setq ccol col))

2441 (setq ccol (+ ccol wd))))

2442 (setq ccol (1+ ccol)))

2443 (if (and YaTeX-japan

2444 (or

2445 (and (fboundp 'char-category)

2446 (string-match "[chj]" (char-category (preceding-char))))

2447 (and (fboundp 'char-charset)

2448 (not (eq (char-charset (preceding-char)) 'ascii)))))

2449 (setq ccol (1+ ccol)))))

2450 (if (and force (> col ccol))

2451 (progn

2452 (insert-char ?\ (- col ccol))

2453 col)

2454 ccol)))

2455

2456 (defun yahtml-fill-paragraph (arg)

2457 (interactive "P")

2458 (let*((case-fold-search t) (p (point)) fill-prefix

2459 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2460 indent

2461 (startp (get 'YaTeX-inner-environment 'point))

2462 (prep (string-match "^pre$" e))

2463 (ps1 (if prep (default-value 'paragraph-start)

2464 paragraph-start))

2465 (ps2 (if prep (concat (default-value 'paragraph-start)

2466 "$\\|^\\s *</?pre>")

2467 paragraph-start)))

2468 (save-excursion

2469 (unwind-protect

2470 (progn

2471 (if prep

2472 (fset 'move-to-column 'yahtml-move-to-column))

2473 (save-excursion

2474 (beginning-of-line)

2475 (indent-to-column (yahtml-this-indent))

2476 (setq fill-prefix

2477 (buffer-substring (point) (point-beginning-of-line)))

2478 (delete-region (point) (point-beginning-of-line)))

2479 (fill-region-as-paragraph

2480 (progn (re-search-backward paragraph-start nil t)

2481 (or (save-excursion

2482 (goto-char (match-beginning 0))

2483 (if (looking-at "<")

2484 (forward-list)

2485 (goto-char (match-end 0))

2486 (skip-chars-forward " \t>"))

2487 (if (looking-at "[ \t]*$")

2488 (progn (forward-line 1) (point))))

2489 (point)))

2490 (progn (goto-char p)

2491 (re-search-forward ps2 nil t)

2492 (match-beginning 0))))

2493 (fset 'move-to-column yahtml-saved-move-to-column)))))

2494

2495 ;(defun yahtml-indent-new-commnet-line ()

2496 ; (unwind-protect

2497 ; (progn

2498 ; (fset 'move-to-column 'yahtml-move-to-column)

2499 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2500 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2501

2502 ;;;

2503 ;;; ---------- indentation ----------

2504 ;;;

2505 (defun yahtml-indent-line ()

2506 "Indent a line (faster wrapper)"

2507 (interactive)

2508 (let (indent)

2509 (if (and (save-excursion

2510 (beginning-of-line) (skip-chars-forward "\t ")

2511 (not (looking-at "<")))

2512 (save-excursion

2513 (forward-line -1)

2514 (while (and (not (bobp)) (looking-at "^\\s *$"))

2515 (forward-line -1))

2516 (skip-chars-forward "\t ")

2517 (setq indent (current-column))

2518 (not (looking-at "<"))))

2519 (progn

2520 (save-excursion

2521 (beginning-of-line)

2522 (skip-chars-forward " \t")

2523 (or (= (current-column) indent)

2524 (YaTeX-reindent indent)))

2525 (and (bolp) (skip-chars-forward " \t")))

2526 (yahtml-indent-line-real))))

2527

2528 (defun yahtml-this-indent ()

2530 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2531 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2532 (excludes

2533 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2534 inenv p col peol (case-fold-search t))

2535 (save-excursion

2536 (beginning-of-line)

2537 (setq inenv (or (yahtml-inner-environment-but excludes t)

2538 "html")

2539 col (get 'YaTeX-inner-environment 'indent)

2540 p (get 'YaTeX-inner-environment 'point)

2541 op nil))

2542 (save-excursion

2543 (cond

2544 ((string-match (concat "^\$" envs "\$") inenv)

2545 (save-excursion

2546 (beginning-of-line)

2547 (skip-chars-forward " \t")

2548 (cond ;lookup current line's tag

2549 ((looking-at (concat "</\$" envs "\$>"))

2550 col)

2551 ((looking-at itms)

2552 (+ col yahtml-environment-indent))

2553 ((and yahtml-hate-too-deep-indentation

2554 (looking-at (concat "<\$" envs "\$")))

2555 (+ col (* 2 yahtml-environment-indent)))

2556 ((and (< p (point))

2557 (string-match itemizing-envs inenv)

2558 (save-excursion

2559 (and

2560 (setq op (point))

2561 (goto-char p)

2562 (re-search-forward itms op t)

2563 (progn

2564 (if yahtml-indent-listing-constant

2565 (setq col (+ (current-column)

2566 (if yahtml-faithful-to-htmllint 1 2)))

2567 (skip-chars-forward "^>")

2568 (skip-chars-forward ">")

2569 (skip-chars-forward " \t")

2570 (setq col (if (looking-at "$")

2571 (+ col yahtml-environment-indent)

2572 (current-column))))))))

2573 col)

2574 (t

2575 (+ col yahtml-environment-indent)))))

2576 (t col)))))

2577

2578 (defun yahtml-indent-line-real ()

2579 "Indent current line."

2580 (interactive)

2581 (YaTeX-reindent (yahtml-this-indent))

2582 (if (bolp) (skip-chars-forward " \t"))

2583 (let (peol col inenv)

2584 (if (and (setq inenv (yahtml-on-begend-p))

2585 (string-match

2586 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2587 (save-excursion

2588 (setq peol (point-end-of-line))

2589 (or (= (char-after (point)) ?<)

2590 (progn (skip-chars-backward "^<") (forward-char -1)))

2591 (setq col (current-column))

2592 (if (and (yahtml-goto-corresponding-begend t)

2593 (> (point) peol)) ;if on the different line

2594 (YaTeX-reindent col))))))

2595

2596 ;(defun yahtml-fill-item ()

2597 ; "Fill item HTML version"

2598 ; (interactive)

2599 ; (let (inenv p fill-prefix peol (case-fold-search t))

2600 ; (setq inenv (or (YaTeX-inner-environment) "html")

2601 ; p (get 'YaTeX-inner-environment 'point))

2602 ; (cond

2603 ; ((string-match "^[uod]l" inenv)

2604 ; (save-excursion

2605 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2606 ; (progn

2607 ; (goto-char (match-end 0))

2608 ; (setq col (current-column)))

2609 ; (error "No <li>, <dt>, <dd>")))

2610 ; (save-excursion

2611 ; (end-of-line)

2612 ; (setq peol (point))

2613 ; (newline)

2614 ; (indent-to-column col)

2615 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2616 ; (delete-region (point) peol)

2617 ; (fill-region-as-paragraph

2618 ; (progn (re-search-backward paragraph-start nil t) (point))

2619 ; (progn (re-search-forward paragraph-start nil t 2)

2620 ; (match-beginning 0)))))

2621 ; (t nil))))

2622

2623 ;;;

2624 ;;; ---------- Lint and Browsing ----------

2625 ;;;

2626 (defun yahtml-browse-menu ()

2627 "Browsing or other external process invokation menu."

2628 (interactive)

2629 (message "J)weblint p)Browse R)eload N)ewpage...")

2630 (let ((c (char-to-string (read-char))))

2631 (cond

2632 ((string-match "j" c)

2633 (yahtml-lint-buffer (current-buffer)))

2634 ((string-match "[bp]" c)

2635 (yahtml-browse-current-file))

2636 ((string-match "r" c)

2637 (yahtml-browse-reload))

2638 ((string-match "n" c)

2639 (call-interactively 'yahtml-newpage)))))

2640

2641 (if (fboundp 'wrap-function-to-control-ime)

2642 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2643

2644 (defvar yahtml-lint-buffer "*weblint*")

2645

2646 (defun yahtml-lint-buffer (buf)

2647 "Call lint on buffer BUF."

2648 (require 'yatexprc)

2649 (interactive "bCall lint on buffer: ")

2650 (setq buf (get-buffer buf))

2651 (YaTeX-save-buffers)

2652 (let ((bcmd (YaTeX-get-builtin "lint")))

2653 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2654 (YaTeX-typeset

2655 (concat (or bcmd yahtml-lint-program)

2656 " " (file-name-nondirectory (buffer-file-name buf)))

2657 yahtml-lint-buffer "lint" "lint")))

2658

2659 (defun yahtml-file-to-url (file)

2660 "Convert local unix file name to URL.

2661 If no matches found in yahtml-path-url-alist, return raw file name."

2662 (let ((list yahtml-path-url-alist) p url)

2663 (if (file-directory-p file)

2664 (setq file (expand-file-name yahtml-directory-index file))

2665 (setq file (expand-file-name file)))

2666 (if (string-match "^[A-Za-z]:/" file)

2667 (progn

2668 ;; (aset file 1 ?|) ;これは要らないらしい…

2669 (setq file (concat "///" file))))

2670 (while list

2671 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2672 (setq url (cdr (car list))

2673 file (substring file (match-end 0))

2674 url (concat url file)

2675 list nil))

2676 (setq list (cdr list)))

2677 (or url (concat "file:" file))))

2678

2679 (defun yahtml-url-to-path (file &optional basedir)

2680 "Convert local URL name to unix file name."

2681 (let ((list yahtml-path-url-alist) url realpath docroot

2682 (dirsufp (string-match "/$" file)))

2683 (setq basedir (or basedir

2684 (file-name-directory

2685 (expand-file-name default-directory))))

2686 (cond

2687 ((string-match "^/" file)

2688 (while list

2689 (if (file-directory-p (car (car list)))

2690 (progn

2691 (setq url (cdr (car list)))

2692 (if (string-match "\$http://[^/]*\$/" url)

2693 (setq docroot (substring url (match-end 1)))

2694 (setq docroot url))

2695 (cond

2696 ((string-match (concat "^" (regexp-quote docroot)) file)

2697 (setq realpath

2698 (expand-file-name

2699 (substring

2700 file

2701 (if (= (aref file (1- (match-end 0))) ?/)

2702 (match-end 0) ; "/foo"

2703 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2704 (car (car list))))))

2705 (if realpath

2706 (progn (setq list nil)

2707 (if (and dirsufp (not (string-match "/$" realpath)))

2708 (setq realpath (concat realpath "/")))))))

2709 (setq list (cdr list)))

2710 realpath)

2711 (t file))))

2712

2713 (defun yahtml-browse-current-file ()

2714 "Call WWW browser on current file."

2715 (interactive)

2716 (basic-save-buffer)

2717 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2718

2719 (defun yahtml-browse-reload ()

2720 "Send `reload' event to netscape."

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

2722 (cond

2723 ((string-match "[Nn]etscape" yahtml-www-browser)

2724 (if (get-buffer pb)

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

2726 ;;(or (get 'yahtml-netscape-sentinel 'url)

2727 ;; (error "Reload should be called after Browsing."))

2728 (put 'yahtml-netscape-sentinel 'url

2729 (yahtml-file-to-url (buffer-file-name)))

2730 (basic-save-buffer)

2731 (set-process-sentinel

2732 (setq yahtml-browser-process

2733 (start-process

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

2735 (format "%s -remote 'reload'" yahtml-www-browser)))

2736 'yahtml-netscape-sentinel))

2737 (t

2738 (message "Sorry, RELOAD is supported only for Netscape.")))))

2739

2740 ;;; ---------- Intelligent newline ----------

2741 (defun yahtml-intelligent-newline (arg)

2742 "Intelligent newline for HTML"

2743 (interactive "P")

2744 (let (env func)

2745 (end-of-line)

2746 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2747 "html")))

2748 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2749 (newline)

2750 (if (and env func (fboundp func))

2751 ;; if intelligent line function is defined, call that

2752 (funcall func)

2753 ;; else do the default action

2754 (if (string-match yahtml-p-prefered-env-regexp env)

2755 (yahtml-insert-p)))))

2756

2757 (defun yahtml-intelligent-newline-ul ()

2758 (interactive)

2759 (yahtml-insert-single "li")

2760 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2761 (yahtml-indent-line))

2762

2763 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2764

2765 (defun yahtml-intelligent-newline-dl ()

2766 (interactive)

2767 (let ((case-fold-search t))

2768 (if (save-excursion

2769 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2770 (get 'YaTeX-inner-environment 'point) t))

2771 (cond

2772 ((match-beginning 2)

2773 (yahtml-insert-single "dd")

2774 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

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

2776 ((match-beginning 3)

2777 (yahtml-insert-single "dt")

2778 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

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

2780 (yahtml-insert-single "dt")

2781 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

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

2783 (yahtml-indent-line)

2784 (and (string-match yahtml-p-prefered-env-regexp "dl")

2785 (string-equal yahtml-last-single-cmd "dt")

2786 (yahtml-insert-p nil))))

2787

2788 (defun yahtml-intelligent-newline-select ()

2789 (interactive)

2790 (yahtml-insert-single (if yahtml-prefer-upcases "OPTION" "option"))

2791 (yahtml-indent-line))

2792

2793 (defun yahtml-intelligent-newline-style ()

2794 (interactive)

2795 (if (save-excursion

2796 (and

2797 (re-search-backward "<style\\|<!-- " nil t)

2798 (looking-at "<style")))

2799 (let (c)

2800 (yahtml-indent-line)

2801 (setq c (current-column))

2802 (insert "<!--\n")

2803 (YaTeX-reindent c)

2804 (insert "-->")

2805 (beginning-of-line)

2806 (open-line 1)

2807 (YaTeX-reindent c))))

2808

2809 (defun yahtml-intelligent-newline-head ()

2810 (let ((title (read-string "Document title: "))

2811 (b "<title>") (e "</title>") p)

2812 (yahtml-indent-line)

2813 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2814 (setq p (point))

2815 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2816 (if (string= "" title) (goto-char p))

2817 (setq yahtml-last-begend "body")))

2818

2819 (defun yahtml-intelligent-newline-script ()

2820 (let ((p (point)) b)

2821 (if (save-excursion

2822 (and

2823 (setq b (re-search-backward "<script\\>" nil t))

2824 (re-search-forward

2825 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2826 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2827 c (srcp (re-search-backward "src=" b t)))

2828 (goto-char p)

2829 (yahtml-indent-line)

2830 (setq c (current-column))

2831 (if srcp

2832 nil

2833 (insert "")

2834 (beginning-of-line)

2835 (open-line 1)

2836 (YaTeX-reindent c))))))

2837

2838 (defun yahtml-intelligent-newline-table ()

2839 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2840 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2841 (cond

2842 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2843 (while (and (setq rb (re-search-backward ptn tb t))

2844 (match-beginning 1))

2845 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2846 (goto-char (match-end 0))

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

2848 (if (and (search-forward "colspan\\s *=" p t)

2849 (progn

2850 (skip-chars-forward "\"' \t\n")

2851 (looking-at "[0-9]+")))

2852 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2853 (setq cols (1+ cols)))

2854 (goto-char rb)

2855 (setq p (point)))

2856 (if (> cols 0)

2857 (message "%s columns found. %s"

2858 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2859 "New tr?(N) or Duplicate")))

2860 (cond

2861 ((and (> cols 0)

2862 (memq (read-char) '(?d ?D))) ;Duplication mode

2863 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2864 (t ;empty cells

2865 (setq line "<tr>" i 0)

2866 (if (> cols 0)

2867 (while (> cols i)

2868 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2869 "<td></td>"))

2870 th nil i (1+ i)))

2871 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2872 (while (string-match "t\$h\$\\|td" fmt i)

2873 (setq line (concat line (if (match-beginning 1) "<th></th>"

2874 "<td></td>"))

2875 i (match-end 0))))

2876 (setq line (concat line "</tr>"))))

2877 (goto-char cp)

2878 (if th

2879 (message

2880 "Type `%s' to change td from/to th."

2881 (key-description (car (where-is-internal 'yahtml-change-*)))))

2882 (if (string< "" line)

2883 (progn

2884 (insert line)

2885 (goto-char (+ 8 cp))

2886 (yahtml-indent-line)))))))

2887

2888 ;;; ---------- Marking ----------

2889 (defun yahtml-mark-begend ()

2890 "Mark current tag"

2891 (interactive)

2892 (YaTeX-beginning-of-environment)

2893 (let ((p (point)))

2894 (save-excursion

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

2896 (if (bolp) (setq p (point))))

2897 (push-mark p t))

2898 (yahtml-goto-corresponding-begend)

2899 (forward-list 1)

2900 (if (eolp) (forward-char 1)))

2901

2902 ;;; ---------- complete marks ----------

2903 (defun yahtml-complete-mark ()

2904 "Complete &gt, &lt, &ampersand, and &quote."

2905 (interactive)

2906 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2907 (let ((c (read-char)))

2908 (setq c (if (or (< c ?0) (> c ?7))

2909 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2910 (- c ?1)))

2911 (if (or (< c 0) (> c 6))

2912 nil

2913 (insert (format "&%s;"

2914 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2915

2916

2917 ;;; ---------- jump to error line ----------

2918 (defun yahtml-prev-error ()

2919 "Jump to previous error seeing lint buffer."

2920 (interactive)

2921 (or (get-buffer yahtml-lint-buffer)

2922 (error "No lint program ran."))

2923 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2924 (yahtml-jump-to-error-line t))

2925

2926 (defun yahtml-jump-to-error-line (&optional sit)

2927 (interactive "P")

2928 (let ((p (point)) (e (point-end-of-line)))

2929 (end-of-line)

2930 (if (re-search-backward yahtml-error-line-regexp nil t)

2931 (let ((f (if (string= "" (YaTeX-match-string 1))

2932 YaTeX-current-file-name

2933 (YaTeX-match-string 1)))

2934 (l (string-to-int (or (YaTeX-match-string 2)

2935 (YaTeX-match-string 3)))))

2936 (if sit (sit-for 1))

2937 (forward-line -1)

2938 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2939 (goto-line l))

2940 (message "No line number usage"))))

2941

2942 ;;; ---------- Style Sheet Support ----------

2943 (defvar yahtml-css-class-alist nil

2944 "Alist of elements vs. their classes")

2945

2946 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2947 (save-excursion

2948 (save-restriction

2949 (narrow-to-region beg end)

2950 (goto-char (point-min))

2951 (let ((alist initial) b e element class a)

2952 (setq b (point))

2953 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2954 (if (match-beginning 2)

2955 (let ((f (YaTeX-buffer-substring

2956 (progn (skip-chars-forward "^\"")(1+ (point)))

2957 (progn (forward-char 1)

2958 (skip-chars-forward "^\"")(point)))))

2959 (if (file-exists-p f)

2960 (setq alist

2961 (append alist (yahtml-css-collect-classes-file

2962 f initial)))))

2963 (setq e (point))

2964 (goto-char b)

2965 (while (re-search-forward ;ちょといい加減なREGEXP

2966 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2967 e t)

2968 (setq element (YaTeX-match-string 1)

2969 class (YaTeX-match-string 2))

2970 ;;if starts with period (match-string 1 is nil),

2971 ;;this is global class

2972 (setq element (downcase (or element "*")))

2973 (if (setq a (assoc element alist))

2974 (or (assoc class (cdr a))

2975 (setcdr a (cons (list class) (cdr a))))

2976 (setq alist (cons (list element (list class)) alist))))

2977 (goto-char (1- e))

2978 (search-forward "}" nil 1) ;1=move to limit when not found.

2979 (setq b (point))))

2980 alist))))

2981

2982 (defun yahtml-css-collect-classes-buffer (&optional initial)

2983 (interactive)

2984 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2985

2986 (defun yahtml-css-collect-classes-file (file &optional initial)

2987 (let*((hilit-auto-highlight nil)

2988 (buf (get-buffer-create

2989 (format " *css-collection*%s" (file-name-nondirectory file))))

2990 (cb (current-buffer)))

2991 (unwind-protect

2992 (progn

2993 (set-buffer buf)

2994 (insert-file-contents file)

2995 (cd (or (file-name-directory file) "."))

2996 (yahtml-css-collect-classes-buffer initial))

2997 (if (eq buf cb)

2998 nil

2999 (kill-buffer buf)

3000 (set-buffer cb)))))

3001

3002 (defun yahtml-css-scan-styles ()

3003 (save-excursion

3004 (goto-char (point-min))

3005 (set (make-local-variable 'yahtml-css-class-alist) nil)

3006 (let (b tag type e href alist)

3007 (while (re-search-forward "<\$style\\|link\$" nil t)

3008 (setq b (match-beginning 0)

3009 tag (YaTeX-match-string 1))

3010 (cond

3011 ((string-match "style" tag)

3012 (goto-char b)

3013 (save-excursion (forward-list 1) (setq e (point)))

3014 (cond

3015 ((search-forward "text/css" e 1) ;css definition starts

3016 (setq alist

3017 (yahtml-css-collect-classes-region

3018 (point) (progn (search-forward "</style>") (point))

3019 alist)))))

3020 ((and (string-match "link" tag)

3021 (stringp (setq type (yahtml-get-attrvalue "type")))

3022 (string-match "text/css" type)

3023 (setq href (yahtml-get-attrvalue "href"))

3024 (file-exists-p (yahtml-url-to-path href)))

3025 (setq alist

3026 (yahtml-css-collect-classes-file

3027 (yahtml-url-to-path href) alist))))

3028 (setq yahtml-css-class-alist alist)))))

3029

3030 (defun yahtml-css-get-element-completion-alist (element)

3031 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3032 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3033 (and (or alist global)

3034 (append alist global))))

3035

3036 ;;; ---------- ----------

3037

3038 ;;;

3039 ;;hilit19

3040 ;;;

3041 (defvar yahtml-default-face-table

3042 '(

3043 (form black/ivory white/hex-442233 italic)

3044 ))

3045 (defvar yahtml-hilit-patterns-alist

3046 '(

3047 'case-fold

3048 ;; comments

3049 ("" comment)

3050 ;; include&exec

3051 ("" include)

3052 ;; string

3053 (hilit-string-find ?\\ string)

3054 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3055 ("</?[uod]l>" 0 decl)

3056 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3057 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3058 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3059 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3060 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3061 ))

3062

3063 (defun yahtml-hilit-region-tag (tag)

3064 "Return list of start/end point of <TAG> form."

3065 (if (re-search-forward tag nil t)

3066 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3067 (elm (YaTeX-match-string 1)))

3068 (skip-chars-forward "^>")

3069 (prog1

3070 (cons (1+ (point))

3071 (progn (re-search-forward (concat "</" elm ">") nil t)

3072 (match-beginning 0)))

3073 (goto-char e0)))))

3074

3075 (defun yahtml-hilit-region-tag-itself (ptn)

3076 "Return list of start/end point of <tag options...> itself."

3077 (if (re-search-forward ptn nil t)

3078 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3079 (skip-chars-forward "^<>")

3080 (if (eq (char-after (point)) ?<) nil

3081 (prog1

3082 (cons m0 (min (point-max) (1+ (point))))

3083 (goto-char e0))))))

3084

3085 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3086 (and yahtml-use-hilit19

3087 (or (assq 'yahtml-mode hilit-patterns-alist)

3088 (setq hilit-patterns-alist

3089 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3090 hilit-patterns-alist))))

3091 ;;;

3092 ;; for font-lock

3093 ;;;

3094

3095 ; <<STATIC KEYWORDS BELOW NOT USED>>

3096 ;(defvar yahtml-font-lock-keywords

3097 ; '(

3098 ; ;; comments

3099 ; ("" . font-lock-comment-face)

3100 ; ;; include&exec

3101 ; (""

3102 ; 0 font-lock-include-face keep)

3103 ; ;; string

3104 ; ;(hilit-string-find ?\\ string)

3105 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3106 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3107 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3108 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3109 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3110 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3111 ; )

3112 ; "*Defualt font-lock-keywords for yahtml-mode.")

3113 (defvar yahtml-font-lock-keywords

3114 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3115 "Default fontifying patterns for yahtml-mode")

3116

3117 (defun yahtml-font-lock-set-default-keywords ()

3118 (put 'yahtml-mode 'font-lock-defaults

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

3120

3121 (if yahtml-use-font-lock

3122 (progn

3123 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3124 ;;for those who use both hilit19 and font-lock

3125 (if (eq (car hilit-mode-enable-list) 'not)

3126 (or (member 'yahtml-mode hilit-mode-enable-list)

3127 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3128 (setq hilit-mode-enable-list

3129 (delq 'yahtml-mode hilit-mode-enable-list))))

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

3131

3132 (defun yahtml-font-lock-recenter (&optional arg)

3133 (interactive "P")

3134 (font-lock-mode -1) ;is stupid, but sure.

3135 (font-lock-mode 1))

3136

3137 ;;;

3138 ;; Drag-n-Drop

3139 ;;;

3140 (defun yahtml-dnd-handler (uri action)

3141 "DnD handler for yahtml mode

3142 Convert image URI to img-src and others to a-href."

3143 (let*((file (dnd-get-local-file-name uri))

3144 (path (if file (file-relative-name file) uri))

3145 (case-fold-search t)

3146 (geom ""))

3147 (cond

3148 ((memq action '(copy link move private))

3149 (cond

3150 ((string-match "\\.\$jpe?g\\|png\\|gif\\|bmp\\|tiff?\$$" path)

3151 (if file

3152 (setq geom (yahtml-get-image-info path)

3153 geom (if (car geom)

3154 (apply 'format " width=\"%s\" height=\"%s\"" geom)

3155 "")))

3156 (insert (format "<img src=\"%s\" alt=\"%s\"%s>"

3157 path (file-name-nondirectory path) geom)))

3158

3159 (t (insert (format "<a href=\"%s\"></a>" path))

3160 (forward-char -4))))

3161 (t (message "No handler for action `%s'" action))))

3162 action)

3163

3164 (run-hooks 'yahtml-load-hook)

3165 (provide 'yahtml)

3166

3167 ; Local variables:

3168 ; fill-prefix: ";;; "

3169 ; paragraph-start: "^$\\|\\|;;;$"

3170 ; paragraph-separate: "^$\\|\\|;;;$"

3171 ; coding: sjis

3172 ; End: