yatex: b6500fb81ee0 yahtml.el

yatex

view yahtml.el @ 324:b6500fb81ee0

Add columnwidth to YaTeX:style-parameters-default

author	HIROSE Yuuji <yuuji@gentei.org>
date	Sun, 21 Sep 2014 14:15:42 +0900
parents	afe97f605d96
children	9cef5d10a0f1

line source

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

3 ;;; Last modified Tue Jun 3 09:40:02 2014 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.76"

7 "Revision number of running yahtml.el")

9 ;;; Commentary:

11 ;;;[Installation]

12 ;;;

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

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

15 ;;;

16 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

25 ;;;

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

27 ;;;

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

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

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

31 ;;;

32 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

41 ;;;

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

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

44 ;;;

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

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

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

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

49 ;;;

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

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

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

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

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

55 ;;;

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

57 ;;;

58 ;;;[Commentary]

59 ;;;

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

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

62 ;;;

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

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

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

66 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

91 ;;; change the reference link with completion.

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

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

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

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

96 ;;; is "firefox")

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

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

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

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

101 ;;; in the region.

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

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

104 ;;; URLencoded string in the region.

105 ;;;

106 ;;;[キーの説明]

107 ;;;

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

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

110 ;;;

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

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

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

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

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

116 ;;; できます。

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

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

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

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

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

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

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

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

125 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

137 ;;; す。

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

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

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

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

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

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

144 ;;; きます。

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

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

147 ;;;

148 ;;; と書いておくとそのコマンドを呼びます。

149 ;;; * [prefix] t p WWW ブラウザでカレントファイルを表示します。

150 ;;; (lisp変数 yahtml-www-browser の設定をお忘れな

151 ;;; く。お推めは "firefox" です)

152 ;;; * [prefix] a YaTeX のアクセント記号補完と同じです。

153 ;;; < > 等が入力できます。

154 ;;; * [prefix] ; 指定したリジョン中の > < & " をそれぞれ

155 ;;; > < & " に変換します。

156 ;;; * [prefix] : 指定したリジョン中で上と逆の変換をします。

157 ;;; * [prefix] # 指定したリジョン中で%エンコードの必要な文字が

158 ;;; あればそれらをエンコードします。

159 ;;; * [prefix] } リジョン内の特定文字区切りのレコードを <td> 並びに

160 ;;; 変換します。C-u (universal-argument) 付きで起動

161 ;;; するとtd以外の任意要素で括ります。thdを指定する

162 ;;; と最初の1つだけth，残りすべてをtdで括ります。

163 ;;; * [prefix] ] リジョン内のすべての行をフィールドごとにtdで括り，

164 ;;; さらに各行をtrで括ります。universal-argument を

165 ;;; 付けるとフィールド括りをtd以外に指定できます。

166 ;;; * [prefix] ESC yahtml-mode を抜け yahtml-mode に入る前に動作し

167 ;;; ていたメジャーモードに戻ります。

168 ;;;

169 ;;; [謝辞]

170 ;;;

171 ;;; fj野鳥の会の皆さんには貴重な助言を頂きました。また、下に示す方々には

172 ;;; 特に大きな協力を頂きました。あわせてここに感謝申し上げます。

173 ;;;

174 ;;; * 横田和也さん(マツダ)

175 ;;; マニュアルの和訳をして頂きました。

176 ;;; * 吉田尚志さん(NTT Data)

177 ;;; Mule for Win32 での動作のさせ方を教えて頂きました。

178 ;;; (というかほとんどやってもらった ^^;)

179 ;;;

180

181 ;;; Code:

182

183 (require 'yatexlib)

184 ;;; --- customizable variable starts here ---

185 (defvar yahtml-prefix "\C-c"

186 "*Prefix key stroke of yahtml functions.")

187 (defvar yahtml-image-viewer "display" "*Image viewer program")

188 (defvar yahtml-www-browser "firefox" "*WWW Browser command")

189 (defvar yahtml-kanji-code 2

190 "*Kanji coding system number of html file; 1=sjis, 2=jis, 3=euc, 4=UTF-8")

191 ;;(defvar yahtml-coding-system

192 ;; (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))

193 ;; "Kanji coding system")

194 (and (featurep 'mule)

195 (integerp yahtml-kanji-code)

196 (setq yahtml-kanji-code

197 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))))

198

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

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

201

202 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")

203 (defvar yahtml-path-url-alist nil

204 "*Alist of unix path name vs. URL name of WWW server.

205 Ex.

206 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")

207 (\"/home/yuuji/http\" . \"http://www.gentei.org/~yuuji\"))")

208 (defvar yahtml-directory-index "index.html"

209 "*Directory index file name;

210 Consult your site's WWW administrator.")

211

212 (defvar yahtml-environment-indent 1

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

214

215 ;; YaTeX-japan is defined in yatexlib.el

216 (defvar yahtml-lint-program (if YaTeX-japan "jweblint" "weblint")

217 "*Program name to lint HTML file")

218 (defvar yahtml-hate-too-deep-indentation nil

219 "*Non-nil for this variable suppress deep indentation in listing environments.")

220

221 (defvar yahtml-always-/p t

222 "*Those who always use <p> with </p> set this to t.")

223 (defvar yahtml-always-/li nil

224 "*Those who always use <li> with </li> set this to t.")

225 (defvar yahtml-always-/dt nil

226 "*Those who always use <dt> with </dt> set this to t.")

227 (defvar yahtml-always-/dd nil

228 "*Those who always use <dd> with </dd> set this to t.")

229

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

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

232

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

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

235

236 (defvar yahtml-prefer-upcases nil

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

238

239 (defvar yahtml-prefer-upcase-attributes nil

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

241

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

243

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

245 "*Server access file name for apache")

246

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

248

249 (defvar yahtml-image-inspection-bytes 500000

250 "*Number of bytes to inspect the image for geometry information")

251 (defvar yahtml:img-default-alt-format "%xx%y(%sbytes)"

252 "*Default format of img entity's ALT attributes.

253 %x: width, %y: height, %s: size in bytes, %c: first comment string,

254 %f: filename")

255

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

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

258

259 (defvar yahtml-error-line-regexp

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

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

262

263 (defvar yahtml-translate-hyphens-when-comment-region t

264 "*Non-nil for translate hyphens to - when comment-region")

265 (defvar yahtml-escape-chars 'ask

266 "*Escape reserved characters to URL-encoding or not.

267 Nil for never, t for everytime, and 'ask for inquiring

268 at each reserved chars.")

269

270 (defvar yahtml-use-font-lock (and (featurep 'font-lock)

271 (fboundp 'font-lock-fontify-region))

272 "*Non-nil means to use font-lock to fontify buffer.")

273

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

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

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

277

278 (defvar yahtml-mode-abbrev-table nil

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

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

281

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

283 "*Boundary regexp for indentation calculation.")

284

285 (defvar yahtml-html4-strict t

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

287 Completing read for obsoleted attributes disabled.")

288

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

290 (defvar yahtml-prefix-map nil)

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

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

293 (defvar yahtml-shell-command-option

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

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

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

297

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

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

300 (YaTeX-define-key

301 key

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

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

304 map))

305

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

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

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

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

310

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

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

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

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

315 (if YaTeX-inhibit-prefix-letter nil

316 (yahtml-define-begend-region-key

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

318

319 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

337 (and YaTeX-emacs-19 window-system

338 (progn

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

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

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

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

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

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

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

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

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

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

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

350 (if YaTeX-no-begend-shortcut

351 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

390 (substitute-all-key-definition

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

392 (substitute-all-key-definition

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

394

395 (if yahtml-lint-buffer-map nil

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

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

398

399

400 (defvar yahtml-paragraph-start

401 (concat

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

403 "*Regexp of html paragraph separater")

404 (defvar yahtml-paragraph-separate

405 (concat

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

407 "*Regexp of html paragraph separater")

408 (defvar yahtml-syntax-table nil

409 "*Syntax table for yahtml-mode")

410

411 (if yahtml-syntax-table nil

412 (setq yahtml-syntax-table

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

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

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

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

417

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

419 "Regexp of constituent of html commands.")

420

421 ;;; Completion tables for `form'

422 (defvar yahtml-form-table

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

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

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

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

427

428 (defvar yahtml-env-table

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

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

431 ("OrderedList" . "ol")

432 ("UnorderedList" . "ul")

433 ("DefinitionList" . "dl")

434 ("Preformatted" . "pre")

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

436 ("address") ("button")

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

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

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

440 ("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 (set-syntax-table yahtml-syntax-table)

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

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

667 (yahtml-css-scan-styles)

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

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

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

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

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

673

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

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

676 font-lock-defaults)

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

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

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

680

681 (defun yahtml-version ()

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

683 (interactive)

684 (message

685 (concat "Yet Another HTML-mode "

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

687 " Revision "

688 yahtml-revision-number)))

689

690 (defun yahtml-quit ()

691 (interactive)

692 (and yahtml-mode-old-mode

693 (fboundp yahtml-mode-old-mode)

694 (funcall yahtml-mode-old-mode)))

695

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

697 (cond

698 ((featurep 'xemacs)

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

700 (set keymap nil)

701 (mapcar

702 (function

703 (lambda (bind)

704 (setq bind (cdr bind))

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

706 (setcar (cdr bind) 'progn))

707 (if (stringp (car (cdr bind)))

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

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

710 (symbol-value keymap))))))

711 bindlist)

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

713 (t

714 (mapcar

715 (function

716 (lambda (bind)

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

718 bindlist))))

719

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

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

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

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

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

725

726 ;;; Variables for mosaic url history

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

728 (defvar yahtml-urls-private nil)

729 (defvar yahtml-urls-local nil)

730

731 (cond

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

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

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

735 (YaTeX-define-menu

736 'yahtml-menu-map-sectioning

737 (nreverse

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

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

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

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

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

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

744 )))

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

746 (YaTeX-define-menu

747 'yahtml-menu-map-logical

748 (nreverse

749 '((em "Embolden" .

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

751 (dfn "Define a word" .

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

753 (cite "Citation" .

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

755 (code "Code" .

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

757 (kbd "Keyboard" .

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

759 (samp "Sample display" .

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

761 (strong "Strong" .

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

763 (VAR "Variable notation" .

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

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

766 (YaTeX-define-menu

767 'yahtml-menu-map-typeface

768 (nreverse

769 '((b "Bold" .

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

771 (i "Italic" .

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

773 (tt "Typewriter" .

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

775 (u "Underlined" .

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

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

778 (YaTeX-define-menu

779 'yahtml-menu-map-listing

780 (nreverse

781 '((ul "Unordered" .

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

783 (ol "Ordered" .

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

785 (dl "Definition" .

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

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

788 (YaTeX-define-menu

789 'yahtml-menu-map-item

790 (nreverse

791 '((li "Simple item" .

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

793 (dt "Define term" .

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

795 (dd "Description of term" .

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

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

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

799 (YaTeX-define-menu

800 'yahtml-menu-map

801 (nreverse

802 (list

803 (cons (list 'sect "Sectioning")

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

805 (cons (list 'list "Listing")

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

807 (cons (list 'item "Item")

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

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

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

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

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

813 (if (featurep 'xemacs)

814 (add-hook 'yahtml-mode-hook

815 '(lambda ()

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

817 (progn

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

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

820

821 ;;; ----------- Completion ----------

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

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

824 "Insert <cmd> ... </cmd>."

825 (interactive "P")

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

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

828 (cmd

829 (or env

830 (YaTeX-cplread-with-learning

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

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

833 (bolp (save-excursion

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

835 (cc (current-column)))

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

837 (setq yahtml-last-begend

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

839 yahtml-last-begend))

840 (setq cmd yahtml-last-begend)

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

842 (if region

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

844 ;; to enable continuous regioning by another environment

845 (let ((beg (region-beginning))

846 (end (region-end))

847 (addin (yahtml-addin cmd)))

848 (save-excursion

849 (goto-char end)

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

851 (goto-char beg)

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

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

854 (save-excursion

855 (insert "\n")

856 (indent-to-column cc)

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

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

859 (newline)

860 (yahtml-intelligent-newline nil))

861 (yahtml-indent-line))))

862

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

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

865 (interactive)

866 (yahtml-insert-begend t))

867

868

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

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

871 (interactive)

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

873 (or form

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

875 (setq form

876 (YaTeX-cplread-with-learning

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

878 'yahtml-form-table 'yahtml-user-form-table

879 'yahtml-tmp-form-table))))

880 (let ((p (point)) q)

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

882 (setq yahtml-last-form form)

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

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

885 ;;(indent-relative-maybe)

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

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

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

889

890 (defun yahtml-read-css (alist)

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

892 (minibuffer-completion-table alist))

893 (read-from-minibuffer

894 (substitute-command-keys

895 (if YaTeX-japan

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

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

898 nil YaTeX-minibuffer-completion-map nil)))

899

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

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

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

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

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

905 (defun yahtml-newpage (file ov)

906 "Create newpage via newpage script"

907 (interactive

908 (list

909 (let (insert-default-directory)

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

911 current-prefix-arg))

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

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

914 (insert (substring

915 (YaTeX-command-to-string

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

917 0 -1)))

918

919 ;;; ---------- Add-in ----------

920 (defun yahtml-addin (form)

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

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

923 (concat

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

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

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

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

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

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

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

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

932 (string< "" s))

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

934 ""))))

935

936 (defvar yahtml-completing-buffer nil)

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

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

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

940 (let (list end)

941 (save-excursion

942 (set-buffer yahtml-completing-buffer)

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

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

945 (save-excursion

946 (goto-char (point-min))

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

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

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

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

951 (setq end (match-end 0))

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

953 (yahtml-on-assignment-p)

954 (progn

955 (goto-char end)

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

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

958 (setq list (cons

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

960 list))))

961 list))))

962

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

964 (if yahtml-url-completion-map nil

965 (setq yahtml-url-completion-map

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

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

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

969

970 (defun yahtml-complete-url ()

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

972 (interactive)

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

974 (lim (YaTeX-minibuffer-begin))

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

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

977 (cond

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

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

980 listfunc (list 'lambda nil

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

982 beg min))

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

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

985 (progn

986 (setq path (substring initial 0 beg))

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

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

989 (setq initial (substring initial beg))

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

991 cmpl (try-completion initial labels)

992 listfunc (list 'lambda ()

993 (list 'all-completions

994 initial (list 'quote labels)))

995 beg (+ min beg)))

996 (t

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

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

999 initial))

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

1001 file (file-name-nondirectory path)

1002 initial file

1003 cmpl (file-name-completion file dir)

1004 listfunc (list 'lambda nil

1005 (list 'file-name-all-completions

1006 file dir))

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

1008 (cond

1009 ((stringp cmpl)

1010 (if (string= initial cmpl)

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

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

1013 (princ

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

1015 (delete-region (point) beg)

1016 (insert cmpl)))

1017 ((null cmpl)

1018 (ding))

1019 ((eq t cmpl)

1020 (save-excursion

1021 (unwind-protect

1022 (progn

1023 (goto-char p)

1024 (insert " [Sole completion]"))

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

1026

1027 ;

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

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

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

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

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

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

1034 ;

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

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

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

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

1039 (defvar yahtml-unsafe-chars-regexp

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

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

1042 ;

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

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

1045 ;

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

1047 ; "$" | ","

1048 (defvar yahtml-unreserved-chars-regexp

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

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

1051 Not used yet.")

1052

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

1054 "Translate reserved chars to URL encoded string."

1055 (let ((p 0) (target "")

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

1057 (cond

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

1059 (t

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

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

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

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

1064 (setq target (concat target

1065 (substring str 0 p)

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

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

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

1069 (concat target str)))))

1070

1071 (defun yahtml-unescape-string (str)

1072 "Untranslate reserved URL-encoded string."

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

1074 (unwind-protect

1075 (progn

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

1077 (setq target (concat target

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

1079 p (match-end 0)

1080 c (YaTeX-hex (substring

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

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

1083 (concat target (substring str p)))

1084 (store-match-data md))))

1085

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

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

1088 (interactive "r")

1089 (save-excursion

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

1091 (goto-char beg)

1092 (while (and (< (point) e)

1093 (re-search-forward

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

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

1096 (sit-for 0)

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

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

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

1100 ; (unwind-protect

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

1102 ; (save-excursion

1103 ; (backward-char 1)

1104 ; (delete-backward-char 4))

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

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

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

1108 (progn

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

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

1111 (set-marker e nil))))

1112 ;; ab%defgls/.|

1113

1114 (defun yahtml:a ()

1115 "Add-in function for <a>"

1116 (let ((href ""))

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

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

1119 href (yahtml-escape-chars-string

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

1121 (prog1

1122 (concat (yahtml-make-optional-argument

1123 "href" href)

1124 (yahtml-make-optional-argument

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

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

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

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

1129 (YaTeX-update-table

1130 (list href)

1131 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1132

1133 (defvar yahtml-parameters-completion-alist

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

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

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

1137 ("src" . file) ("file" . file)

1138 ("background" . file)

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

1140 ("method" ("POST") ("GET"))

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

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

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

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

1145 ("http-equiv" ("Refresh"))))

1146

1147 (defvar yahtml-link-types-alist

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

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

1150 ("subsection") ("appendix") ("help") ("bookmark")))

1151

1152 (defvar yahtml-content-types-alist

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

1154 ("text/sgml") ("text/xml")

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

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

1157 ("application/java")

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

1159 "Alist of content-types")

1160

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

1162 (let* ((alist

1163 (cdr-safe (assoc (downcase par)

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

1165 (prompt (concat par ": "))

1166 v)

1167 (cond

1168 ((eq alist 'file)

1169 (let ((insert-default-directory))

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

1171 ((eq alist 'command)

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

1173 (read-shell-command prompt)

1174 (read-string prompt)))

1175 ((and alist (symbolp alist))

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

1177 (alist

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

1179 (t

1180 (read-string prompt default)))))

1181

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

1183 "Make optional argument string."

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

1185 ""

1186 (concat " "

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

1188 "=\"" arg "\"")))

1189

1190 (defun yahtml:html ()

1191 "Add-in for <html>"

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

1193 (yahtml-make-optional-argument

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

1195

1196 (defun yahtml:head ()

1197 "Add-in for <head>"

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

1199 "")

1200

1201 (defun yahtml:body ()

1202 "Add-in function for <body>"

1203 (cond

1204 (yahtml-html4-strict nil)

1205 (t

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

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

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

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

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

1211 (concat

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

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

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

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

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

1217

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

1219 "Make CSS property definitions in style attribute."

1220 (mapconcat

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

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

1223 (delq nil proplist)

1224 " "))

1225

1226 (defun yahtml:img ()

1227 "Add-in function for <img>"

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

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

1230 alt

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

1232 (l yahtml-prefer-upcase-attributes)

1233 info width height bytes comments)

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

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

1236 (car info)

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

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

1239 bytes (car (cdr (cdr info)))

1240 comments (nth 4 info)))

1241 (if info

1242 (setq alt

1243 (YaTeX-replace-formats

1244 yahtml:img-default-alt-format

1245 (list (cons "x" width)

1246 (cons "y" height)

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

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

1249 (cons "c" (car comments))))))

1250

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

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

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

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

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

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

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

1258 (if yahtml-html4-strict

1259 (yahtml-make-optional-argument

1260 "style"

1261 (if (or brd alg)

1262 (yahtml-make-style-parameter

1263 (list

1264 (if (string< "" alg)

1265 (cons "align" alg))

1266 (if (string< "" brd)

1267 (cons "border"

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

1269 (concat

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

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

1272

1273 (defun yahtml-file-truename (file)

1274 (cond

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

1276 (t (let ((new file))

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

1278 (not (equal new file)))

1279 (setq file new))

1280 file))))

1281

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

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

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

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

1286 (let ((mlt 1)

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

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

1289 (value 0))

1290 (while (> length 0)

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

1292 pos (+ pos direc)

1293 mlt (* mlt 256)

1294 length (1- length)))

1295 value))

1296

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

1298 "Return the information on the image file FILE.

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

1300 (save-excursion

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

1302 width height bytes depth comment

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

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

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

1306 (seekpoint 1)

1307 c1 c2 c3 c4 beg end

1308 (case-fold-search nil))

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

1310 (set-buffer tmpbuf)

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

1312 (erase-buffer)

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

1314 (unwind-protect

1315 (progn

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

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

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

1319 (YaTeX-insert-file-contents

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

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

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

1323 c2 (char-after 2)

1324 c3 (char-after 3)

1325 c4 (char-after 4))

1326 (cond

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

1328 ;;JPEG images need JPEG markers inspection

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

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

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

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

1333 (catch 'exit

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

1335 (cond

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

1337 ;maybe corrupted, exit from loop

1338 (throw 'exit t))

1339 ((memq

1340 (char-after (1+ seekpoint))

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

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

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

1344 ;;found!

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

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

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

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

1349 ;; JPEG comment area

1350 (setq beg (+ seekpoint 2 2)

1351 end (+ seekpoint

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

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

1354 (t ;other markers

1355 nil)) ;just skip it

1356 (setq seekpoint (+ seekpoint 2)

1357 seekpoint (+ seekpoint

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

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

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

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

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

1363 height (yahtml-hex-value 20 4)

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

1365 ((looking-at "GIF8")

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

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

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

1369 ((looking-at "BM")

1370 ;;# OS/2, Windoze BMP files

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

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

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

1374 (cond

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

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

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

1378 (t

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

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

1381 (message "")

1382 (kill-buffer tmpbuf))

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

1384

1385 (defun yahtml:form ()

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

1387 (concat

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

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

1390 "\""

1391 (yahtml-make-optional-argument

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

1393 (completing-read

1394 "Enctype: "

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

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

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

1398

1399 (defun yahtml:select ()

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

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

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

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

1404

1405 (defun yahtml:ol ()

1406 "Add-in function for <ol>"

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

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

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

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

1411 (concat

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

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

1414 (defun yahtml:ul ()

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

1416 (defun yahtml:dl ()

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

1418 (defun yahtml:dt ()

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

1420

1421 (defun yahtml:p ()

1422 (if yahtml-html4-strict nil

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

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

1425

1426 (defvar yahtml-input-types

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

1428 ("reset") ("image") ("hidden") ("file")))

1429

1430 (defun yahtml:input ()

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

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

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

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

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

1436 yahtml-input-types nil t)

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

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

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

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

1441 (concat

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

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

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

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

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

1447

1448 (defun yahtml:textarea ()

1449 "Add-in function for `textarea'"

1450 (interactive)

1451 (let (name rows cols)

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

1453 cols (read-string "Columns: ")

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

1455 (concat

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

1457 "\"" name "\"")

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

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

1460

1461 (defun yahtml:table ()

1462 "Add-in function for `table'"

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

1464 (a (yahtml-read-parameter

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

1466 (if yahtml-html4-strict

1467 (yahtml-make-optional-argument

1468 "style"

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

1470 (yahtml-make-style-parameter

1471 (append

1472 (if (string< "" b)

1473 (list

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

1475 (cons "border-collapse" "collapse")))

1476 (if (string< "" a)

1477 (cond

1478 ((string-match "right" a)

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

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

1481 ((string-match "center" a)

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

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

1484 (concat

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

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

1487

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

1489 (defun yahtml:caption ()

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

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

1492 (if yahtml-html4-strict

1493 (yahtml-make-optional-argument

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

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

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

1497

1498 (defun yahtml:font ()

1499 "Add-in function for `font'"

1500 (concat

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

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

1503

1504 (defun yahtml:style ()

1505 "Add-in function for `style'"

1506 (yahtml-make-optional-argument

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

1508

1509 (defun yahtml:script ()

1510 "Add-in function for `script'"

1511 (concat

1512 (yahtml-make-optional-argument

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

1514 (yahtml-make-optional-argument

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

1516

1517 (defun yahtml:tr ()

1518 "Add-in function for `tr'"

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

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

1521 "")

1522

1523 (defun yahtml:link ()

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

1525 (let (rel rev type href)

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

1527 (cond

1528 ((equal rel "")

1529 (concat (yahtml-make-optional-argument

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

1531 (yahtml-make-optional-argument

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

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

1534 )))

1535 ((string-match "stylesheet" rel)

1536 (concat

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

1538 (yahtml-make-optional-argument

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

1540 (progn

1541 (setq href

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

1543 (if (string< "" href)

1544 (progn

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

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

1547 (setq yahtml-css-class-alist

1548 (yahtml-css-collect-classes-file

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

1550 (message "")

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

1552 (t

1553 (concat

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

1555 (yahtml-make-optional-argument

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

1557 (yahtml-make-optional-argument

1558 "href"

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

1560

1561 (defvar yahtml:meta-names

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

1563

1564 (defun yahtml:meta ()

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

1566 "name"

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

1568 http-equiv content)

1569 (if (string= "" name)

1570 (if (string-match

1571 "Content-type"

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

1573 "http-equiv"

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

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

1576 "See docs/qanda")

1577 (concat http-equiv

1578 (yahtml-make-optional-argument

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

1580 (concat

1581 name

1582 (yahtml-make-optional-argument

1583 "content"

1584 (cond

1585 ((string-match "date" name)

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

1587 ((string-match "author" name)

1588 (read-string "Author: "

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

1590 (user-full-name)

1591 (user-login-name))))

1592 ((string-match "GENERATOR" name)

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

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

1595 (message "Thank you!"))

1596 content)

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

1598

1599 (defun yahtml:br ()

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

1601

1602 (defun yahtml:object ()

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

1604 data classid)

1605 (cond

1606 ((string-match "java" codetype)

1607 (let ((completion-ignored-extensions

1608 ;;any extensions except ".class"

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

1610 (setq classid (concat "java:"

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

1612 (concat

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

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

1615 (yahtml-make-optional-argument

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

1617 (yahtml-make-optional-argument

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

1619 (yahtml-make-optional-argument

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

1621 (t

1622 ""))))

1623

1624 (defun yahtml:abbr ()

1625 "Add-in function for abbr."

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

1627

1628 (defun yahtml:button ()

1629 (concat

1630 (yahtml-make-optional-argument

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

1632 (yahtml-make-optional-argument

1633 "type" (yahtml-read-parameter

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

1635 (yahtml-make-optional-argument

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

1637

1638 ;;; ---------- Simple tag ----------

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

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

1641 (interactive "P")

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

1643 (or tag

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

1645 (setq tag

1646 (YaTeX-cplread-with-learning

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

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

1649 'yahtml-typeface-table 'yahtml-user-typeface-table

1650 'yahtml-tmp-typeface-table))))

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

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

1653 (setq yahtml-last-typeface-cmd tag

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

1655 (if region-mode

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

1657 (save-excursion

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

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

1660 (exchange-point-and-mark)

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

1662 (message "No mark set now"))

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

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

1665

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

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

1668 (interactive)

1669 (yahtml-insert-tag t tag))

1670

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

1672 (defun yahtml-insert-single (cmd)

1673 "Insert <CMD>."

1674 (interactive

1675 (list

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

1677 (YaTeX-cplread-with-learning

1678 (format "Command%s: "

1679 (if yahtml-last-single-cmd

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

1681 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1684 (setq yahtml-last-single-cmd

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

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

1687 yahtml-last-single-cmd))

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

1689 cmd

1690 (yahtml-addin cmd)

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

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

1693 " /" "")))

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

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

1696

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

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

1699 (interactive "P")

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

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

1702

1703 (defun yahtml-insert-amps (arg)

1704 "Insert char-entity references via ampersand"

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

1706 (interactive "P")

1707 (let*((mess "") c

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

1709 yahtml-entity-reference-chars-alist))

1710 (l list))

1711 (while l

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

1713 l (cdr l)))

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

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

1716 (setq c (read-char))

1717 (cond

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

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

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

1721 (insert "&;")

1722 (forward-char -1))

1723 ((equal c ? )

1724 (insert ?&))

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

1726 (setq c (preceding-char))

1727 (delete-backward-char 1)

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

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

1730

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

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

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

1734

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

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

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

1738

1739 ;;; ---------- Jump ----------

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

1741 "Check if point is on href clause."

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

1743 (save-excursion

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

1745 (save-excursion

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

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

1748 (setq e (point)))

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

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

1751 (search-forward "href" e t)

1752 (search-forward "=" e t)

1753 (progn

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

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

1756 (< p (match-end 0))

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

1758

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

1760 (cond

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

1762 (set-process-buffer proc nil))

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

1764 (let ((cb (current-buffer)))

1765 (set-buffer (process-buffer proc))

1766 (goto-char (point-min))

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

1768 (progn

1769 (message "Starting netscape...")

1770 (start-process

1771 "browser" (process-buffer proc)

1772 shell-file-name yahtml-shell-command-option

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

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

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

1776 (set-buffer cb)))))

1777

1778 (defvar yahtml-browser-process nil)

1779

1780 (defun yahtml-browse-html (href)

1781 "Call WWW Browser to see HREF."

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

1783 (cond

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

1785 (if (get-buffer pb)

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

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

1788 (set-process-sentinel

1789 (setq yahtml-browser-process

1790 (start-process

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

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

1793 'yahtml-netscape-sentinel))

1794 ((and (string-match

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

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

1797 (if (get-buffer pb)

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

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

1800 (set-process-sentinel

1801 (setq yahtml-browser-process

1802 (start-process

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

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

1805 'yahtml-netscape-sentinel))

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

1807 (w3-fetch href))

1808 ((stringp yahtml-www-browser)

1809 (if (and yahtml-browser-process

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

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

1812 (setq yahtml-browser-process

1813 (start-process

1814 "browser" "* WWW Browser *"

1815 shell-file-name yahtml-shell-command-option

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

1817 (t

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

1819

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

1821 "Go to corresponding name."

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

1823 (if href

1824 (cond

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

1826 (yahtml-browse-html href))

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

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

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

1830 (if (string< "" file)

1831 (progn

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

1833 (or (catch 'dirindex

1834 (mapcar

1835 (function

1836 (lambda (f)

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

1838 (throw 'dirindex

1839 (setq file (concat file f))))))

1840 (yahtml-get-directory-index))

1841 nil)

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

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

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

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

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

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

1848 (if name

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

1850 t)))))

1851

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

1853 "Jump to html's named tag."

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

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

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

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

1858

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

1860 "Check if point is on begend clause."

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

1862 (save-excursion

1863 (goto-char p)

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

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

1866 (looking-at

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

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

1869 (condition-case nil

1870 (forward-list 1)

1871 (error nil))

1872 (< p (point)))

1873 (YaTeX-match-string 1)))))

1874

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

1876 "Go to corresponding opening/closing tag.

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

1878 (let ((cmd (yahtml-on-begend-p)) m0

1879 (p (point)) (case-fold-search t) func str (nest 0))

1880 (cond

1881 (cmd

1882 (setq m0 (match-beginning 0))

1883 (if (= (aref cmd 0) ?/) ;on </cmd> line

1884 (setq cmd (substring cmd 1)

1885 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1886 func 're-search-backward)

1887 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1888 func 're-search-forward))

1889 (while (and (>= nest 0) (funcall func str nil t))

1890 (if (equal m0 (match-beginning 0))

1891 nil

1892 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1893 (if (< nest 0)

1894 (goto-char (match-beginning 0))

1895 (funcall

1896 (if noerr 'message 'error)

1897 "Corresponding tag of `%s' not found." cmd)

1898 (goto-char p)

1899 nil))

1900 (t nil))))

1901

1902 (defun yahtml-current-tag ()

1903 "Return the current tag name including #exec and #include."

1904 (save-excursion

1905 (let ((p (point)) b tag)

1906 (or (bobp)

1907 (looking-at "<")

1908 (progn (skip-chars-backward "^<") (forward-char -1)))

1909 (setq b (point))

1910 (skip-chars-forward "<")

1911 (setq tag (YaTeX-buffer-substring

1912 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1913 (goto-char b)

1914 (forward-list 1)

1915 (and (< p (point)) tag))))

1916

1917 (defun yahtml-get-attrvalue (attr)

1918 "Extract current tag's attribute value from buffer."

1919 (let (e (case-fold-search t))

1920 (save-excursion

1921 (or (looking-at "<")

1922 (progn (skip-chars-backward "^<") (backward-char 1)))

1923 (setq e (save-excursion (forward-list 1) (point)))

1924 (if (and

1925 (re-search-forward (concat "\\b" attr "\\b") e t)

1926 (progn (skip-chars-forward " \t\n=")

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

1928 (YaTeX-match-string 1)))))

1929

1930 (defun yahtml-goto-corresponding-img ()

1931 "View image on point"

1932 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1933 (if (and tag

1934 (string-match "img" tag)

1935 (setq image

1936 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1937 (progn

1938 (message "Invoking %s %s..." yahtml-image-viewer image)

1939 (start-process

1940 "Viewer" " * Image Viewer *"

1941 shell-file-name yahtml-shell-command-option ;"-c"

1942 (concat yahtml-image-viewer " " image))

1943 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1944

1945 (defun yahtml-goto-corresponding-source (&optional other)

1946 "Goto applet's or script's source."

1947 (let ((env (yahtml-current-tag)) s (p (point)))

1948 (cond

1949 ((string-match "applet" env)

1950 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1951 (progn

1952 (setq s (YaTeX-match-string 1)

1953 s (concat

1954 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1955 ".java"))

1956 (if other (YaTeX-switch-to-buffer-other-window s)

1957 (YaTeX-switch-to-buffer s))

1958 s) ;return source file name

1959 (message "No applet source specified")

1960 (sit-for 1)

1961 nil))

1962 ((string-match "script" env)

1963 (if (setq s (yahtml-get-attrvalue "src"))

1964 (progn

1965 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1966 'YaTeX-switch-to-buffer)

1967 (yahtml-url-to-path s))

1968 s)))

1969 ((string-match "!--#include" env)

1970 (cond

1971 ((setq s (yahtml-get-attrvalue "file")) ;

1972 (if other (YaTeX-switch-to-buffer-other-window s)

1973 (YaTeX-switch-to-buffer s))

1974 s)

1975 ((setq s (yahtml-get-attrvalue "virtual"));

1976 (setq s (yahtml-url-to-path s))

1977 (if other (YaTeX-switch-to-buffer-other-window s)

1978 (YaTeX-switch-to-buffer s))

1979 s)))

1980 ((and (string-match "!--#exec" env)

1981 (setq s (yahtml-get-attrvalue "cmd")))

1982 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1983 (let ((b " *yahtmltmp*")) ;peek a little

1984 (unwind-protect

1985 (progn

1986 (set-buffer (get-buffer-create b))

1987 (YaTeX-insert-file-contents s nil 0 100)

1988 (if (looking-at "#!")

1989 (if other (YaTeX-switch-to-buffer-other-window s)

1990 (YaTeX-switch-to-buffer s))))

1991 (kill-buffer (get-buffer b)))

1992 (get-file-buffer s))))))

1993

1994 (defun yahtml-goto-corresponding-* (&optional other)

1995 "Go to corresponding object."

1996 (interactive "P")

1997 (cond

1998 ((yahtml-goto-corresponding-href other))

1999 ((yahtml-goto-corresponding-img))

2000 ((yahtml-goto-corresponding-source other))

2001 ((yahtml-goto-corresponding-begend))

2002 (t (message "I don't know where to go."))))

2003

2004 (defun yahtml-goto-corresponding-*-other-window ()

2005 "Go to corresponding object."

2006 (interactive)

2007 (yahtml-goto-corresponding-* t))

2008

2009 (defun yahtml-visit-main ()

2010 "Go to parent file from where you visit current file."

2011 (interactive)

2012 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2013

2014 ;;; ---------- killing ----------

2015 (defun yahtml-kill-begend (&optional whole)

2016 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2017 (if tag

2018 (save-excursion

2019 (or (looking-at "<")

2020 (progn (skip-chars-backward "^<") (forward-char -1)))

2021 (setq p (point))

2022 (yahtml-goto-corresponding-begend)

2023 (or (looking-at "<")

2024 (progn (skip-chars-backward "^<") (forward-char -1)))

2025 (if (< (point) p) ;if on the opening tag

2026 (progn (setq q p p (point))

2027 (goto-char q))

2028 (setq q (point))) ;now q has end-line's (point)

2029 (if (not whole)

2030 (kill-region

2031 (progn (skip-chars-backward " \t")

2032 (if (setq bbolp (bolp)) (point) q))

2033 (progn (forward-list 1)

2034 (setq r (point))

2035 (skip-chars-forward " \t")

2036 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2037 (goto-char p)

2038 (skip-chars-backward " \t")

2039 (if (not whole)

2040 (progn

2041 (kill-append

2042 (buffer-substring

2043 (setq p (if (setq bbolp (bolp)) (point) p))

2044 (setq q (progn

2045 (forward-list 1)

2046 (setq r (point))

2047 (skip-chars-forward " \t")

2048 (if (and bbolp (eolp) (not (eobp)))

2049 (1+ (point))

2050 r))))

2051 t)

2052 (delete-region p q))

2053 (kill-region

2054 (if (bolp) (point) p)

2055 (progn (goto-char q)

2056 (forward-list 1)

2057 (setq r (point))

2058 (skip-chars-forward " \t")

2059 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2060 tag))))

2061

2062 (defun yahtml-kill-* (whole)

2063 "Kill current position's HTML tag (set)."

2064 (interactive "P")

2065 (cond

2066 ((yahtml-kill-begend whole))))

2067

2068

2069 ;;; ---------- changing ----------

2070 (defun yahtml-on-assignment-p ()

2071 "Return if current point is on parameter assignment.

2072 If so, return parameter name, otherwise nil.

2073 This function should be able to treat white spaces in value, but not yet."

2074 (let ((p (point)))

2075 (save-excursion

2076 (put 'yahtml-on-assignment-p 'region nil)

2077 (skip-chars-backward "^ \t\n")

2078 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2079 (< p (match-end 0))

2080 (>= p (1- (match-beginning 2)))

2081 (put 'yahtml-on-assignment-p 'region

2082 (cons (match-beginning 2) (match-end 2)))

2083 (YaTeX-match-string 1)))))

2084

2085 (defun yahtml-change-begend ()

2086 (let ((tag (yahtml-on-begend-p))

2087 (completion-ignore-case t)

2088 (case-fold-search t)

2089 (p (point)) (q (make-marker))

2090 (default (append yahtml-env-table yahtml-typeface-table))

2091 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2092 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2093 href b1 e1 attr new css)

2094 (cond

2095 (tag

2096 (cond

2097 ((and (string-match "^a$" tag)

2098 (save-excursion

2099 (and

2100 (re-search-backward "<a\\b" nil t)

2101 (progn

2102 (goto-char (match-end 0))

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

2104 (setq b1 (point))

2105 (search-forward ">" nil t))

2106 (setq e1 (match-beginning 0))

2107 (goto-char b1)

2108 (re-search-forward "href\\s *=" e1 t)

2109 (>= p (point))

2110 (progn

2111 (goto-char (match-end 0))

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

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

2114 (< p (match-end 0)))))

2115 (setq b1 (match-beginning 1) e1 (match-end 1)

2116 yahtml-completing-buffer (current-buffer)

2117 ;; yahtml-urls-local is buffer-local, so we must put

2118 ;; that into yahtml-urls here

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

2120 href (read-from-minibuffer

2121 "Change href to: " "" yahtml-url-completion-map))

2122 (if (string< "" href)

2123 (progn

2124 ;;(setq href ;??

2125 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2126 (delete-region b1 e1)

2127 (goto-char b1)

2128 (insert href))))

2129 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2130 (if (and (equal attr "class") ;treat "class" attribute specially

2131 (setq css (yahtml-css-get-element-completion-alist tag)))

2132

2133 (setq new (yahtml-read-css css))

2134 ;;other than "class", read parameter normally

2135 (setq new (yahtml-read-parameter attr)))

2136 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2137 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2138 (insert new))

2139 (t

2140 (save-excursion

2141 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2142 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2143 (skip-chars-forward "^A-Za-z")

2144 (set-marker q (point))

2145 (setq p (point))

2146 (yahtml-goto-corresponding-begend)

2147 (or (= (char-after (point)) ?<)

2148 (skip-chars-backward "^<"))

2149 (skip-chars-forward "^A-Za-z")

2150 (if (= (char-after (1- (point))) ?/)

2151 (progn

2152 (set-marker q (point))

2153 (goto-char p)))

2154 (setq tag (let ((completion-ignore-case t))

2155 (YaTeX-cplread-with-learning

2156 (format "Change `%s' to(default %s): "

2157 tag yahtml-last-begend)

2158 'default 'user 'tmp)))

2159 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2160 (if (string= "" tag) (setq tag yahtml-last-begend))

2161 (setq yahtml-last-begend

2162 (or (cdr (assoc tag yahtml-env-table)) tag)

2163 tag yahtml-last-begend)

2164 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2165 (insert (format "%s%s" tag (yahtml-addin tag)))

2166 (goto-char q)

2167 (set-marker q nil)

2168 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2169 (insert tag))))

2170 t))))

2171

2172 (defun yahtml-change-command ()

2173 (let ((p (point)) (case-fold-search t) cmd par new

2174 (beg (make-marker)) (end (make-marker)))

2175 (skip-chars-backward "^<")

2176 (if (and

2177 (looking-at yahtml-command-regexp)

2178 (progn

2179 (set-marker beg (match-beginning 0))

2180 (set-marker end (match-end 0))

2181 t) ;for further work

2182 (progn

2183 (forward-char -1)

2184 (condition-case nil

2185 (forward-list 1)

2186 (error nil))

2187 (< p (point))))

2188 (progn

2189 (goto-char p)

2190 (if (setq par (yahtml-on-assignment-p))

2191 (progn

2192 (setq new (yahtml-read-parameter par))

2193 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2194 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2195 (setq new

2196 (YaTeX-cplread-with-learning

2197 "Change form to: "

2198 'yahtml-form-table 'yahtml-user-form-table

2199 'yahtml-tmp-form-table)))

2200 (delete-region beg end)

2201 (goto-char beg)

2202 (set-marker beg nil)

2203 (set-marker end nil)

2204 (insert new)

2205 t)

2206 (goto-char p)

2207 nil)))

2208

2209 (defun yahtml-change-* ()

2210 "Change current position's HTML tag (set)."

2211 (interactive)

2212 (cond

2213 ((yahtml-change-begend))

2214 ((yahtml-change-command))))

2215

2216 ;;; ---------- commenting ----------

2217

2218 (defun yahtml-comment-region (&optional uncom)

2219 "Comment out region or environment."

2220 (interactive)

2221 (let ((e (make-marker)) be beg p)

2222 (cond

2223 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2224 (setq be (yahtml-on-begend-p))

2225 (save-excursion

2226 (setq p (point))

2227 (if (string-match "^/" be)

2228 (setq beg (progn (forward-line 1) (point)))

2229 (setq beg (progn (beginning-of-line) (point))))

2230 (goto-char p)

2231 (yahtml-goto-corresponding-begend)

2232 (if (string-match "^/" be)

2233 (beginning-of-line)

2234 (forward-line 1))

2235 (set-marker e (point))

2236 ;(comment-region beg (point) (if uncom (list 4)))))

2237 ))

2238 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2239 (setq beg (region-beginning))

2240 (set-marker e (region-end))))

2241 (if yahtml-translate-hyphens-when-comment-region

2242 (let ((yahtml-entity-reference-chars-alist-default nil)

2243 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2244 yahtml-entity-reference-chars-regexp

2245 yahtml-entity-reference-chars-reverse-regexp)

2246 (yahtml-entity-reference-chars-setup)

2247 (funcall

2248 (if uncom 'yahtml-translate-reverse-region

2249 'yahtml-translate-region)

2250 beg e)))

2251 (comment-region beg e (if uncom (list 4)))

2252 (set-marker e nil)))

2253

2254 (defun yahtml-uncomment-region ()

2255 (interactive)

2256 (yahtml-comment-region t))

2257

2258 ;;; ---------- translate to entity references ----------

2259 (defvar yahtml-entity-reference-chars-alist-default

2260 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2261 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2262 "Default translation table from character to entity reference")

2263 (defvar yahtml-entity-reference-chars-alist nil

2264 "*Translation table from character to entity reference")

2265 (defvar yahtml-entity-reference-chars-regexp nil)

2266 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2267

2268 (defun yahtml-entity-reference-chars-setup ()

2269 (let ((list (append yahtml-entity-reference-chars-alist-default

2270 yahtml-entity-reference-chars-alist)))

2271 (setq yahtml-entity-reference-chars-regexp "["

2272 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2273 (while list

2274 (setq yahtml-entity-reference-chars-regexp

2275 (concat yahtml-entity-reference-chars-regexp

2276 (char-to-string (car (car list))))

2277 yahtml-entity-reference-chars-reverse-regexp

2278 (concat yahtml-entity-reference-chars-reverse-regexp

2279 (cdr (car list))

2280 (if (cdr list) "\\|")))

2281 (setq list (cdr list)))

2282 (setq yahtml-entity-reference-chars-regexp

2283 (concat yahtml-entity-reference-chars-regexp "]")

2284 yahtml-entity-reference-chars-reverse-regexp

2285 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2286

2287 (yahtml-entity-reference-chars-setup)

2288

2289 (defun yahtml-translate-region (beg end)

2290 "Translate inhibited literals."

2291 (interactive "r")

2292 (save-excursion

2293 (save-restriction

2294 (narrow-to-region beg end)

2295 (let ((ct (append yahtml-entity-reference-chars-alist

2296 yahtml-entity-reference-chars-alist-default)))

2297 (goto-char beg)

2298 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2299 ;(setq c (preceding-char))

2300 (replace-match

2301 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2302

2303 (defun yahtml-translate-reverse-region (beg end)

2304 "Translate entity references to literals."

2305 (interactive "r")

2306 (save-excursion

2307 (save-restriction

2308 (narrow-to-region beg end)

2309 (let ((ct (append yahtml-entity-reference-chars-alist

2310 yahtml-entity-reference-chars-alist-default))

2311 ec)

2312 (goto-char beg)

2313 (while (re-search-forward

2314 yahtml-entity-reference-chars-reverse-regexp nil t)

2315 ;(setq c (preceding-char))

2316 (setq ec (YaTeX-match-string 1))

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

2318 (insert (car (YaTeX-rassoc ec ct))))))))

2319

2320 (defun yahtml-inner-environment-but (exclude &optional quick)

2321 "Return the inner environment but matches with EXCLUDE tag."

2322 (let (e (case-fold-search t))

2323 (save-excursion

2324 (while (and (setq e (YaTeX-inner-environment quick))

2325 (string-match exclude e))

2326 (goto-char (get 'YaTeX-inner-environment 'point))))

2327 e))

2328

2329 (defun yahtml-untranslate-string (str)

2330 "Untranslate entity reference."

2331 (let ((md (match-data)) (left "") (right str) b0 ch

2332 (ct (append yahtml-entity-reference-chars-alist

2333 yahtml-entity-reference-chars-alist-default))

2334 (revrex yahtml-entity-reference-chars-reverse-regexp))

2335 (unwind-protect

2336 (progn

2337 (while (string< "" right)

2338 (cond

2339 ((string-match revrex right)

2340 (setq ch (YaTeX-rassoc

2341 (substring right (match-beginning 1) (match-end 1)))

2342 b0 (substring right 0 (match-beginning 0))

2343 right (substring right (match-end 0))

2344 left (concat left

2345 (substring right 0 (match-beginning 0))

2346 (char-to-string ch))))

2347 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2348 (setq ch (substring right (match-beginning 2) (match-end 2))

2349 b0 (substring right 0 (match-beginning 0))

2350 right (substring right (match-end 0))

2351 left (concat left

2352 b0

2353 (char-to-string

2354 (if (match-beginning 1)

2355 (YaTeX-hex ch)

2356 (string-to-number ch))))))

2357 (t (setq left (concat left right)

2358 right ""))))

2359 left)

2360 (store-match-data md))))

2361

2362 ;;; ---------- table-ize region ----------

2363 (defun yahtml-td-region (e delim beg end)

2364 "Enclose each item in a region with <td>..</td>.

2365 Interactive prefix argument consults enclosing element other than td."

2366 (interactive "P\nsDelimiter(s): \nr")

2367 (let ((e (cond

2368 ((null e) "td")

2369 ((stringp e) e)

2370 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2371 (ws "[ \t]")

2372 elm p i)

2373 (if (string= delim "") (setq delim " \t\n"))

2374 (setq delim (concat "[" delim "]+")

2375 elm (if (string= "thd" e)

2376 (cons "th" "td")

2377 (cons e e)))

2378 (save-excursion

2379 (save-restriction

2380 (narrow-to-region beg end)

2381 (goto-char (setq p (point-min)))

2382 (setq i 0 e (car elm))

2383 (while (re-search-forward delim nil t)

2384 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2385 (goto-char (match-beginning 0))

2386 (insert "</" e ">")

2387 (save-excursion

2388 (goto-char p)

2389 (insert "<" e ">"))

2390 (setq p (point))

2391 (while (and (not (eobp)) (looking-at ws))

2392 (delete-char 1))

2393 (if (looking-at delim) (delete-char 1)))

2394 (insert "<" e ">")

2395 (goto-char (point-max))

2396 (insert "</" e ">")))))

2397

2398 (defun yahtml-tr-region (e delim beg end)

2399 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2400 (interactive "P\nsDelimiter(s): \nr")

2401 (setq e (if (and e (listp e))

2402 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2403 "th")))

2404 (save-excursion

2405 (save-restriction

2406 (narrow-to-region (point) (mark))

2407 (goto-char (point-min))

2408 (while (not (eobp))

2409 (insert "<tr>")

2410 (yahtml-td-region e delim (point) (point-end-of-line))

2411 (end-of-line)

2412 (insert "</tr>")

2413 (forward-line 1)))))

2414

2415 ;;; ---------- filling ----------

2416 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2417 (defun yahtml-move-to-column (col &optional force)

2418 (beginning-of-line)

2419 (let ((ccol 0))

2420 (while (and (> col ccol) (not (eolp)))

2421 (if (eq (following-char) ?\<)

2422 (progn

2423 (while (and (not (eq (following-char) ?\>))

2424 (not (eolp)))

2425 (forward-char))

2426 (or (eolp) (forward-char)))

2427 (or (eolp) (forward-char))

2428 (if (eq (preceding-char) ?\t)

2429 (let ((wd (- 8 (% (+ ccol 8) 8))))

2430 (if (and force (< col (+ ccol wd)))

2431 (progn

2432 (backward-char 1)

2433 (insert-char ?\ (- col ccol))

2434 (setq ccol col))

2435 (setq ccol (+ ccol wd))))

2436 (setq ccol (1+ ccol)))

2437 (if (and YaTeX-japan

2438 (or

2439 (and (fboundp 'char-category)

2440 (string-match "[chj]" (char-category (preceding-char))))

2441 (and (fboundp 'char-charset)

2442 (not (eq (char-charset (preceding-char)) 'ascii)))))

2443 (setq ccol (1+ ccol)))))

2444 (if (and force (> col ccol))

2445 (progn

2446 (insert-char ?\ (- col ccol))

2447 col)

2448 ccol)))

2449

2450 (defun yahtml-fill-paragraph (arg)

2451 (interactive "P")

2452 (let*((case-fold-search t) (p (point)) fill-prefix

2453 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2454 indent

2455 (startp (get 'YaTeX-inner-environment 'point))

2456 (prep (string-match "^pre$" e))

2457 (ps1 (if prep (default-value 'paragraph-start)

2458 paragraph-start))

2459 (ps2 (if prep (concat (default-value 'paragraph-start)

2460 "$\\|^\\s *</?pre>")

2461 paragraph-start)))

2462 (save-excursion

2463 (unwind-protect

2464 (progn

2465 (if prep

2466 (fset 'move-to-column 'yahtml-move-to-column))

2467 (save-excursion

2468 (beginning-of-line)

2469 (indent-to-column (yahtml-this-indent))

2470 (setq fill-prefix

2471 (buffer-substring (point) (point-beginning-of-line)))

2472 (delete-region (point) (point-beginning-of-line)))

2473 (fill-region-as-paragraph

2474 (progn (re-search-backward paragraph-start nil t)

2475 (or (save-excursion

2476 (goto-char (match-beginning 0))

2477 (if (looking-at "<")

2478 (forward-list)

2479 (goto-char (match-end 0))

2480 (skip-chars-forward " \t>"))

2481 (if (looking-at "[ \t]*$")

2482 (progn (forward-line 1) (point))))

2483 (point)))

2484 (progn (goto-char p)

2485 (re-search-forward ps2 nil t)

2486 (match-beginning 0))))

2487 (fset 'move-to-column yahtml-saved-move-to-column)))))

2488

2489 ;(defun yahtml-indent-new-commnet-line ()

2490 ; (unwind-protect

2491 ; (progn

2492 ; (fset 'move-to-column 'yahtml-move-to-column)

2493 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2494 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2495

2496 ;;;

2497 ;;; ---------- indentation ----------

2498 ;;;

2499 (defun yahtml-indent-line ()

2500 "Indent a line (faster wrapper)"

2501 (interactive)

2502 (let (indent)

2503 (if (and (save-excursion

2504 (beginning-of-line) (skip-chars-forward "\t ")

2505 (not (looking-at "<")))

2506 (save-excursion

2507 (forward-line -1)

2508 (while (and (not (bobp)) (looking-at "^\\s *$"))

2509 (forward-line -1))

2510 (skip-chars-forward "\t ")

2511 (setq indent (current-column))

2512 (not (looking-at "<"))))

2513 (progn

2514 (save-excursion

2515 (beginning-of-line)

2516 (skip-chars-forward " \t")

2517 (or (= (current-column) indent)

2518 (YaTeX-reindent indent)))

2519 (and (bolp) (skip-chars-forward " \t")))

2520 (yahtml-indent-line-real))))

2521

2522 (defun yahtml-this-indent ()

2524 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2525 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2526 (excludes

2527 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2528 inenv p col peol (case-fold-search t))

2529 (save-excursion

2530 (beginning-of-line)

2531 (setq inenv (or (yahtml-inner-environment-but excludes t)

2532 "html")

2533 col (get 'YaTeX-inner-environment 'indent)

2534 p (get 'YaTeX-inner-environment 'point)

2535 op nil))

2536 (save-excursion

2537 (cond

2538 ((string-match (concat "^\$" envs "\$") inenv)

2539 (save-excursion

2540 (beginning-of-line)

2541 (skip-chars-forward " \t")

2542 (cond ;lookup current line's tag

2543 ((looking-at (concat "</\$" envs "\$>"))

2544 col)

2545 ((looking-at itms)

2546 (+ col yahtml-environment-indent))

2547 ((and yahtml-hate-too-deep-indentation

2548 (looking-at (concat "<\$" envs "\$")))

2549 (+ col (* 2 yahtml-environment-indent)))

2550 ((and (< p (point))

2551 (string-match itemizing-envs inenv)

2552 (save-excursion

2553 (and

2554 (setq op (point))

2555 (goto-char p)

2556 (re-search-forward itms op t)

2557 (progn

2558 (if yahtml-indent-listing-constant

2559 (setq col (+ (current-column)

2560 (if yahtml-faithful-to-htmllint 1 2)))

2561 (skip-chars-forward "^>")

2562 (skip-chars-forward ">")

2563 (skip-chars-forward " \t")

2564 (setq col (if (looking-at "$")

2565 (+ col yahtml-environment-indent)

2566 (current-column))))))))

2567 col)

2568 (t

2569 (+ col yahtml-environment-indent)))))

2570 (t col)))))

2571

2572 (defun yahtml-indent-line-real ()

2573 "Indent current line."

2574 (interactive)

2575 (YaTeX-reindent (yahtml-this-indent))

2576 (if (bolp) (skip-chars-forward " \t"))

2577 (let (peol col inenv)

2578 (if (and (setq inenv (yahtml-on-begend-p))

2579 (string-match

2580 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2581 (save-excursion

2582 (setq peol (point-end-of-line))

2583 (or (= (char-after (point)) ?<)

2584 (progn (skip-chars-backward "^<") (forward-char -1)))

2585 (setq col (current-column))

2586 (if (and (yahtml-goto-corresponding-begend t)

2587 (> (point) peol)) ;if on the different line

2588 (YaTeX-reindent col))))))

2589

2590 ;(defun yahtml-fill-item ()

2591 ; "Fill item HTML version"

2592 ; (interactive)

2593 ; (let (inenv p fill-prefix peol (case-fold-search t))

2594 ; (setq inenv (or (YaTeX-inner-environment) "html")

2595 ; p (get 'YaTeX-inner-environment 'point))

2596 ; (cond

2597 ; ((string-match "^[uod]l" inenv)

2598 ; (save-excursion

2599 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2600 ; (progn

2601 ; (goto-char (match-end 0))

2602 ; (setq col (current-column)))

2603 ; (error "No <li>, <dt>, <dd>")))

2604 ; (save-excursion

2605 ; (end-of-line)

2606 ; (setq peol (point))

2607 ; (newline)

2608 ; (indent-to-column col)

2609 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2610 ; (delete-region (point) peol)

2611 ; (fill-region-as-paragraph

2612 ; (progn (re-search-backward paragraph-start nil t) (point))

2613 ; (progn (re-search-forward paragraph-start nil t 2)

2614 ; (match-beginning 0)))))

2615 ; (t nil))))

2616

2617 ;;;

2618 ;;; ---------- Lint and Browsing ----------

2619 ;;;

2620 (defun yahtml-browse-menu ()

2621 "Browsing or other external process invokation menu."

2622 (interactive)

2623 (message "J)weblint p)Browse R)eload N)ewpage...")

2624 (let ((c (char-to-string (read-char))))

2625 (cond

2626 ((string-match "j" c)

2627 (yahtml-lint-buffer (current-buffer)))

2628 ((string-match "[bp]" c)

2629 (yahtml-browse-current-file))

2630 ((string-match "r" c)

2631 (yahtml-browse-reload))

2632 ((string-match "n" c)

2633 (call-interactively 'yahtml-newpage)))))

2634

2635 (if (fboundp 'wrap-function-to-control-ime)

2636 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2637

2638 (defvar yahtml-lint-buffer "*weblint*")

2639

2640 (defun yahtml-lint-buffer (buf)

2641 "Call lint on buffer BUF."

2642 (require 'yatexprc)

2643 (interactive "bCall lint on buffer: ")

2644 (setq buf (get-buffer buf))

2645 (YaTeX-save-buffers)

2646 (let ((bcmd (YaTeX-get-builtin "lint")))

2647 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2648 (YaTeX-typeset

2649 (concat (or bcmd yahtml-lint-program)

2650 " " (file-name-nondirectory (buffer-file-name buf)))

2651 yahtml-lint-buffer "lint" "lint")))

2652

2653 (defun yahtml-file-to-url (file)

2654 "Convert local unix file name to URL.

2655 If no matches found in yahtml-path-url-alist, return raw file name."

2656 (let ((list yahtml-path-url-alist) p url)

2657 (if (file-directory-p file)

2658 (setq file (expand-file-name yahtml-directory-index file))

2659 (setq file (expand-file-name file)))

2660 (if (string-match "^[A-Za-z]:/" file)

2661 (progn

2662 ;; (aset file 1 ?|) ;これは要らないらしい…

2663 (setq file (concat "///" file))))

2664 (while list

2665 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2666 (setq url (cdr (car list))

2667 file (substring file (match-end 0))

2668 url (concat url file)

2669 list nil))

2670 (setq list (cdr list)))

2671 (or url (concat "file:" file))))

2672

2673 (defun yahtml-url-to-path (file &optional basedir)

2674 "Convert local URL name to unix file name."

2675 (let ((list yahtml-path-url-alist) url realpath docroot

2676 (dirsufp (string-match "/$" file)))

2677 (setq basedir (or basedir

2678 (file-name-directory

2679 (expand-file-name default-directory))))

2680 (cond

2681 ((string-match "^/" file)

2682 (while list

2683 (if (file-directory-p (car (car list)))

2684 (progn

2685 (setq url (cdr (car list)))

2686 (if (string-match "\$http://[^/]*\$/" url)

2687 (setq docroot (substring url (match-end 1)))

2688 (setq docroot url))

2689 (cond

2690 ((string-match (concat "^" (regexp-quote docroot)) file)

2691 (setq realpath

2692 (expand-file-name

2693 (substring

2694 file

2695 (if (= (aref file (1- (match-end 0))) ?/)

2696 (match-end 0) ; "/foo"

2697 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2698 (car (car list))))))

2699 (if realpath

2700 (progn (setq list nil)

2701 (if (and dirsufp (not (string-match "/$" realpath)))

2702 (setq realpath (concat realpath "/")))))))

2703 (setq list (cdr list)))

2704 realpath)

2705 (t file))))

2706

2707 (defun yahtml-browse-current-file ()

2708 "Call WWW browser on current file."

2709 (interactive)

2710 (basic-save-buffer)

2711 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2712

2713 (defun yahtml-browse-reload ()

2714 "Send `reload' event to netscape."

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

2716 (cond

2717 ((string-match "[Nn]etscape" yahtml-www-browser)

2718 (if (get-buffer pb)

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

2720 ;;(or (get 'yahtml-netscape-sentinel 'url)

2721 ;; (error "Reload should be called after Browsing."))

2722 (put 'yahtml-netscape-sentinel 'url

2723 (yahtml-file-to-url (buffer-file-name)))

2724 (basic-save-buffer)

2725 (set-process-sentinel

2726 (setq yahtml-browser-process

2727 (start-process

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

2729 (format "%s -remote 'reload'" yahtml-www-browser)))

2730 'yahtml-netscape-sentinel))

2731 (t

2732 (message "Sorry, RELOAD is supported only for Netscape.")))))

2733

2734 ;;; ---------- Intelligent newline ----------

2735 (defun yahtml-intelligent-newline (arg)

2736 "Intelligent newline for HTML"

2737 (interactive "P")

2738 (let (env func)

2739 (end-of-line)

2740 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2741 "html")))

2742 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2743 (newline)

2744 (if (and env func (fboundp func))

2745 ;; if intelligent line function is defined, call that

2746 (funcall func)

2747 ;; else do the default action

2748 (if (string-match yahtml-p-prefered-env-regexp env)

2749 (yahtml-insert-p)))))

2750

2751 (defun yahtml-intelligent-newline-ul ()

2752 (interactive)

2753 (yahtml-insert-single "li")

2754 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2755 (yahtml-indent-line))

2756

2757 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2758

2759 (defun yahtml-intelligent-newline-dl ()

2760 (interactive)

2761 (let ((case-fold-search t))

2762 (if (save-excursion

2763 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2764 (get 'YaTeX-inner-environment 'point) t))

2765 (cond

2766 ((match-beginning 2)

2767 (yahtml-insert-single "dd")

2768 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

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

2770 ((match-beginning 3)

2771 (yahtml-insert-single "dt")

2772 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

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

2774 (yahtml-insert-single "dt")

2775 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

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

2777 (yahtml-indent-line)

2778 (and (string-match yahtml-p-prefered-env-regexp "dl")

2779 (string-equal yahtml-last-single-cmd "dt")

2780 (yahtml-insert-p nil))))

2781

2782 (defun yahtml-intelligent-newline-select ()

2783 (interactive)

2784 (yahtml-insert-single (if yahtml-prefer-upcases "OPTION" "option"))

2785 (yahtml-indent-line))

2786

2787 (defun yahtml-intelligent-newline-style ()

2788 (interactive)

2789 (if (save-excursion

2790 (and

2791 (re-search-backward "<style\\|<!-- " nil t)

2792 (looking-at "<style")))

2793 (let (c)

2794 (yahtml-indent-line)

2795 (setq c (current-column))

2796 (insert "<!--\n")

2797 (YaTeX-reindent c)

2798 (insert "-->")

2799 (beginning-of-line)

2800 (open-line 1)

2801 (YaTeX-reindent c))))

2802

2803 (defun yahtml-intelligent-newline-head ()

2804 (let ((title (read-string "Document title: "))

2805 (b "<title>") (e "</title>") p)

2806 (yahtml-indent-line)

2807 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2808 (setq p (point))

2809 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2810 (if (string= "" title) (goto-char p))

2811 (setq yahtml-last-begend "body")))

2812

2813 (defun yahtml-intelligent-newline-script ()

2814 (let ((p (point)) b)

2815 (if (save-excursion

2816 (and

2817 (setq b (re-search-backward "<script\\>" nil t))

2818 (re-search-forward

2819 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2820 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2821 c (srcp (re-search-backward "src=" b t)))

2822 (goto-char p)

2823 (yahtml-indent-line)

2824 (setq c (current-column))

2825 (if srcp

2826 nil

2827 (insert "")

2828 (beginning-of-line)

2829 (open-line 1)

2830 (YaTeX-reindent c))))))

2831

2832 (defun yahtml-intelligent-newline-table ()

2833 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2834 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2835 (cond

2836 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2837 (while (and (setq rb (re-search-backward ptn tb t))

2838 (match-beginning 1))

2839 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2840 (goto-char (match-end 0))

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

2842 (if (and (search-forward "colspan\\s *=" p t)

2843 (progn

2844 (skip-chars-forward "\"' \t\n")

2845 (looking-at "[0-9]+")))

2846 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2847 (setq cols (1+ cols)))

2848 (goto-char rb)

2849 (setq p (point)))

2850 (if (> cols 0)

2851 (message "%s columns found. %s"

2852 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2853 "New tr?(N) or Duplicate")))

2854 (cond

2855 ((and (> cols 0)

2856 (memq (read-char) '(?d ?D))) ;Duplication mode

2857 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2858 (t ;empty cells

2859 (setq line "<tr>" i 0)

2860 (if (> cols 0)

2861 (while (> cols i)

2862 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2863 "<td></td>"))

2864 th nil i (1+ i)))

2865 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2866 (while (string-match "t\$h\$\\|td" fmt i)

2867 (setq line (concat line (if (match-beginning 1) "<th></th>"

2868 "<td></td>"))

2869 i (match-end 0))))

2870 (setq line (concat line "</tr>"))))

2871 (goto-char cp)

2872 (if th

2873 (message

2874 "Type `%s' to change td from/to th."

2875 (key-description (car (where-is-internal 'yahtml-change-*)))))

2876 (if (string< "" line)

2877 (progn

2878 (insert line)

2879 (goto-char (+ 8 cp))

2880 (yahtml-indent-line)))))))

2881

2882 ;;; ---------- Marking ----------

2883 (defun yahtml-mark-begend ()

2884 "Mark current tag"

2885 (interactive)

2886 (YaTeX-beginning-of-environment)

2887 (let ((p (point)))

2888 (save-excursion

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

2890 (if (bolp) (setq p (point))))

2891 (push-mark p t))

2892 (yahtml-goto-corresponding-begend)

2893 (forward-list 1)

2894 (if (eolp) (forward-char 1)))

2895

2896 ;;; ---------- complete marks ----------

2897 (defun yahtml-complete-mark ()

2898 "Complete &gt, &lt, &ampersand, and &quote."

2899 (interactive)

2900 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2901 (let ((c (read-char)))

2902 (setq c (if (or (< c ?0) (> c ?7))

2903 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2904 (- c ?1)))

2905 (if (or (< c 0) (> c 6))

2906 nil

2907 (insert (format "&%s;"

2908 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2909

2910

2911 ;;; ---------- jump to error line ----------

2912 (defun yahtml-prev-error ()

2913 "Jump to previous error seeing lint buffer."

2914 (interactive)

2915 (or (get-buffer yahtml-lint-buffer)

2916 (error "No lint program ran."))

2917 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2918 (yahtml-jump-to-error-line t))

2919

2920 (defun yahtml-jump-to-error-line (&optional sit)

2921 (interactive "P")

2922 (let ((p (point)) (e (point-end-of-line)))

2923 (end-of-line)

2924 (if (re-search-backward yahtml-error-line-regexp nil t)

2925 (let ((f (if (string= "" (YaTeX-match-string 1))

2926 YaTeX-current-file-name

2927 (YaTeX-match-string 1)))

2928 (l (string-to-int (or (YaTeX-match-string 2)

2929 (YaTeX-match-string 3)))))

2930 (if sit (sit-for 1))

2931 (forward-line -1)

2932 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2933 (goto-line l))

2934 (message "No line number usage"))))

2935

2936 ;;; ---------- Style Sheet Support ----------

2937 (defvar yahtml-css-class-alist nil

2938 "Alist of elements vs. their classes")

2939

2940 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2941 (save-excursion

2942 (save-restriction

2943 (narrow-to-region beg end)

2944 (goto-char (point-min))

2945 (let ((alist initial) b e element class a)

2946 (setq b (point))

2947 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2948 (if (match-beginning 2)

2949 (let ((f (YaTeX-buffer-substring

2950 (progn (skip-chars-forward "^\"")(1+ (point)))

2951 (progn (forward-char 1)

2952 (skip-chars-forward "^\"")(point)))))

2953 (if (file-exists-p f)

2954 (setq alist

2955 (append alist (yahtml-css-collect-classes-file

2956 f initial)))))

2957 (setq e (point))

2958 (goto-char b)

2959 (while (re-search-forward ;ちょといい加減なREGEXP

2960 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2961 e t)

2962 (setq element (YaTeX-match-string 1)

2963 class (YaTeX-match-string 2))

2964 ;;if starts with period (match-string 1 is nil),

2965 ;;this is global class

2966 (setq element (downcase (or element "*")))

2967 (if (setq a (assoc element alist))

2968 (or (assoc class (cdr a))

2969 (setcdr a (cons (list class) (cdr a))))

2970 (setq alist (cons (list element (list class)) alist))))

2971 (goto-char (1- e))

2972 (search-forward "}" nil 1) ;1=move to limit when not found.

2973 (setq b (point))))

2974 alist))))

2975

2976 (defun yahtml-css-collect-classes-buffer (&optional initial)

2977 (interactive)

2978 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2979

2980 (defun yahtml-css-collect-classes-file (file &optional initial)

2981 (let*((hilit-auto-highlight nil)

2982 (buf (get-buffer-create

2983 (format " *css-collection*%s" (file-name-nondirectory file))))

2984 (cb (current-buffer)))

2985 (unwind-protect

2986 (progn

2987 (set-buffer buf)

2988 (insert-file-contents file)

2989 (cd (or (file-name-directory file) "."))

2990 (yahtml-css-collect-classes-buffer initial))

2991 (if (eq buf cb)

2992 nil

2993 (kill-buffer buf)

2994 (set-buffer cb)))))

2995

2996 (defun yahtml-css-scan-styles ()

2997 (save-excursion

2998 (goto-char (point-min))

2999 (set (make-local-variable 'yahtml-css-class-alist) nil)

3000 (let (b tag type e href alist)

3001 (while (re-search-forward "<\$style\\|link\$" nil t)

3002 (setq b (match-beginning 0)

3003 tag (YaTeX-match-string 1))

3004 (cond

3005 ((string-match "style" tag)

3006 (goto-char b)

3007 (save-excursion (forward-list 1) (setq e (point)))

3008 (cond

3009 ((search-forward "text/css" e 1) ;css definition starts

3010 (setq alist

3011 (yahtml-css-collect-classes-region

3012 (point) (progn (search-forward "</style>") (point))

3013 alist)))))

3014 ((and (string-match "link" tag)

3015 (stringp (setq type (yahtml-get-attrvalue "type")))

3016 (string-match "text/css" type)

3017 (setq href (yahtml-get-attrvalue "href"))

3018 (file-exists-p (yahtml-url-to-path href)))

3019 (setq alist

3020 (yahtml-css-collect-classes-file

3021 (yahtml-url-to-path href) alist))))

3022 (setq yahtml-css-class-alist alist)))))

3023

3024 (defun yahtml-css-get-element-completion-alist (element)

3025 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3026 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3027 (and (or alist global)

3028 (append alist global))))

3029

3030 ;;; ---------- ----------

3031

3032 ;;;

3033 ;;hilit19

3034 ;;;

3035 (defvar yahtml-default-face-table

3036 '(

3037 (form black/ivory white/hex-442233 italic)

3038 ))

3039 (defvar yahtml-hilit-patterns-alist

3040 '(

3041 'case-fold

3042 ;; comments

3043 ("" comment)

3044 ;; include&exec

3045 ("" include)

3046 ;; string

3047 (hilit-string-find ?\\ string)

3048 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3049 ("</?[uod]l>" 0 decl)

3050 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3051 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3052 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3053 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3054 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3055 ))

3056

3057 (defun yahtml-hilit-region-tag (tag)

3058 "Return list of start/end point of <TAG> form."

3059 (if (re-search-forward tag nil t)

3060 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3061 (elm (YaTeX-match-string 1)))

3062 (skip-chars-forward "^>")

3063 (prog1

3064 (cons (1+ (point))

3065 (progn (re-search-forward (concat "</" elm ">") nil t)

3066 (match-beginning 0)))

3067 (goto-char e0)))))

3068

3069 (defun yahtml-hilit-region-tag-itself (ptn)

3070 "Return list of start/end point of <tag options...> itself."

3071 (if (re-search-forward ptn nil t)

3072 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3073 (skip-chars-forward "^<>")

3074 (if (eq (char-after (point)) ?<) nil

3075 (prog1

3076 (cons m0 (min (point-max) (1+ (point))))

3077 (goto-char e0))))))

3078

3079 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3080 (and yahtml-use-hilit19

3081 (or (assq 'yahtml-mode hilit-patterns-alist)

3082 (setq hilit-patterns-alist

3083 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3084 hilit-patterns-alist))))

3085 ;;;

3086 ;; for font-lock

3087 ;;;

3088

3089 ; <<STATIC KEYWORDS BELOW NOT USED>>

3090 ;(defvar yahtml-font-lock-keywords

3091 ; '(

3092 ; ;; comments

3093 ; ("" . font-lock-comment-face)

3094 ; ;; include&exec

3095 ; (""

3096 ; 0 font-lock-include-face keep)

3097 ; ;; string

3098 ; ;(hilit-string-find ?\\ string)

3099 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3100 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3101 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3102 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3103 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3104 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3105 ; )

3106 ; "*Defualt font-lock-keywords for yahtml-mode.")

3107 (defvar yahtml-font-lock-keywords

3108 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3109 "Default fontifying patterns for yahtml-mode")

3110

3111 (defun yahtml-font-lock-set-default-keywords ()

3112 (put 'yahtml-mode 'font-lock-defaults

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

3114

3115 (if yahtml-use-font-lock

3116 (progn

3117 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3118 ;;for those who use both hilit19 and font-lock

3119 (if (eq (car hilit-mode-enable-list) 'not)

3120 (or (member 'yahtml-mode hilit-mode-enable-list)

3121 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3122 (setq hilit-mode-enable-list

3123 (delq 'yahtml-mode hilit-mode-enable-list))))

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

3125

3126 (defun yahtml-font-lock-recenter (&optional arg)

3127 (interactive "P")

3128 (font-lock-mode -1) ;is stupid, but sure.

3129 (font-lock-mode 1))

3130

3131 (run-hooks 'yahtml-load-hook)

3132 (provide 'yahtml)

3133

3134 ; Local variables:

3135 ; fill-prefix: ";;; "

3136 ; paragraph-start: "^$\\|\\|;;;$"

3137 ; paragraph-separate: "^$\\|\\|;;;$"

3138 ; coding: sjis

3139 ; End: