yatex: ce2deaceb818 yahtml.el

yatex

view yahtml.el @ 88:ce2deaceb818

yatex-1.74

author	yuuji@gentei.org
date	Mon, 28 Sep 2009 11:37:51 +0900
parents	f14ec50103d0
children	4be83051f641

line source

1 ;;; -*- Emacs-Lisp -*-

3 ;;; Last modified Mon Sep 28 10:45:04 2009 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.72"

7 "Revision number of running yahtml.el")

9 ;;;[Installation]

10 ;;;

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

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

13 ;;;

14 ;;; (setq auto-mode-alist

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

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

17 ;;; (setq yahtml-www-browser "netscape")

18 ;;; ;Write your favorite browser. But netscape is advantageous.

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

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

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

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

23 ;;;

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

25 ;;;

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

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

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

29 ;;;

30 ;;; (setq auto-mode-alist

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

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

33 ;;; (setq yahtml-www-browser "netscape")

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

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

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

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

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

39 ;;;

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

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

42 ;;;

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

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

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

46 ;;;

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

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

49 ;;; ;HTMLファイルの漢字コードを変更する場合は 1=SJIS、2=JIS、3=EUC

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

51 ;;;

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

53 ;;;

54 ;;;[Commentary]

55 ;;;

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

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

58 ;;;

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

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

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

62 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

87 ;;; change the reference link with completion.

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

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

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

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

92 ;;; is "netscape")

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

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

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

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

97 ;;; in the region.

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

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

100 ;;; URLencoded string in the region.

101 ;;;

102 ;;;[キーの説明]

103 ;;;

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

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

106 ;;;

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

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

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

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

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

112 ;;; できます。

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

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

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

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

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

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

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

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

121 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

133 ;;; す。

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

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

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

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

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

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

140 ;;; きます。

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

142 ;;; す。

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

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

145 ;;; く。お推めは "netscape" で、ねすけの場合既にねす

146 ;;; けが起動されていた場合そのねすけに Reload 命令を

147 ;;; 送るという芸当が出来ます)

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

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

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

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

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

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

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

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

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

157 ;;;

158 ;;; [謝辞]

159 ;;;

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

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

162 ;;;

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

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

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

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

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

168 ;;;

169

170

171 ;(require 'yatex)

172 (require 'yatexlib)

173 ;;; --- customizable variable starts here ---

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

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

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

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

178 (defvar yahtml-kanji-code 2

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

180 ;;(defvar yahtml-coding-system

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

182 ;; "Kanji coding system")

183 (and (featurep 'mule)

184 (integerp yahtml-kanji-code)

185 (setq yahtml-kanji-code

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

187

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

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

190

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

192 (defvar yahtml-path-url-alist nil

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

194 Ex.

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

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

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

198 "*Directory index file name;

199 Consult your site's WWW administrator.")

200

201 (defvar yahtml-environment-indent 1

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

203

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

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

206 "*Program name to lint HTML file")

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

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

209

210 (defvar yahtml-always-/p t

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

212 (defvar yahtml-always-/li nil

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

214 (defvar yahtml-always-/dt nil

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

216 (defvar yahtml-always-/dd nil

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

218

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

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

221

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

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

224

225 (defvar yahtml-prefer-upcases nil

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

227

228 (defvar yahtml-prefer-upcase-attributes nil

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

230

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

232

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

234 "*Server access file name for apache")

235

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

237

238 (defvar yahtml-image-inspection-bytes 50000 ;256

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

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

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

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

243 %f: filename")

244

245 (defvar yahtml-faithful-to-htmllint nil)

246 (defvar yahtml-error-line-regexp

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

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

249

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

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

252 (defvar yahtml-escape-chars 'ask

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

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

255 at each reserved chars.")

256

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

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

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

260

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

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

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

264

265 (defvar yahtml-mode-abbrev-table nil

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

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

268

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

270 "*Boundary regexp for indentation calculation.")

271

272 (defvar yahtml-html4-strict t

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

274 Completing read for obsoleted attributes disabled.")

275

276 ;;; --- customizable variable ends here ---

277 (defvar yahtml-prefix-map nil)

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

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

280 (defvar yahtml-shell-command-option

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

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

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

284

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

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

287 (YaTeX-define-key

288 key

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

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

291 map))

292

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

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

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

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

297

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

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

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

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

302 (if YaTeX-inhibit-prefix-letter nil

303 (yahtml-define-begend-region-key

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

305

306 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

319 (let ((map yahtml-prefix-map))

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

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

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

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

324 (and YaTeX-emacs-19 window-system

325 (progn

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

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

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

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

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

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

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

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

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

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

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

337 (if YaTeX-no-begend-shortcut

338 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

361 )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

376 )

377 (substitute-all-key-definition

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

379 (substitute-all-key-definition

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

381

382 (if yahtml-lint-buffer-map nil

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

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

385

386

387 (defvar yahtml-paragraph-start

388 (concat

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

390 "*Regexp of html paragraph separater")

391 (defvar yahtml-paragraph-separate

392 (concat

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

394 "*Regexp of html paragraph separater")

395 (defvar yahtml-syntax-table nil

396 "*Syntax table for yahtml-mode")

397

398 (if yahtml-syntax-table nil

399 (setq yahtml-syntax-table

400 (make-syntax-table (standard-syntax-table)))

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

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

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

404 )

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

406 "Regexp of constituent of html commands.")

407

408 ;;; Completion tables for `form'

409 (defvar yahtml-form-table

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

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

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

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

414

415 (defvar yahtml-env-table

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

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

418 ("OrderedList" . "ol")

419 ("UnorderedList" . "ul")

420 ("DefinitionList" . "dl")

421 ("Preformatted" . "pre")

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

423 ("address")

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

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

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

427 ))

428

429 (if yahtml-html4-strict

430 (setq yahtml-env-table

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

432

433 ;(defvar yahtml-itemizing-regexp

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

435 ; "Regexp of itemizing forms")

436

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

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

439

440 ;;; Completion tables for typeface designator

441 (and yahtml-always-/p

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

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

444 (and yahtml-always-/li

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

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

447 (and yahtml-always-/dt

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

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

450 (and yahtml-always-/dd

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

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

453

454 (defvar yahtml-typeface-table

455 (append

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

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

458 ("sup") ("sub") ("span") ("abbr"))

459 (if (not yahtml-html4-strict)

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

461 yahtml-env-table)

462 "Default completion table of typeface designator")

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

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

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

466

467 (defvar yahtml-single-cmd-table

468 '(("hr") ("br") ("option")

469 ("HorizontalRule" . "hr")

470 ("BreakLine" . "br")

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

472 ("!--#exec")

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

474 ("!--#include")

475 ;; ("Item" . "li")

476 ;; ("DefineTerm" . "dt")

477 ;; ("Description" . "dd")

478 ;; ("dd") ("dt") ("li")

479 )

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

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

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

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

484

485 (defvar yahtml-current-completion-type nil

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

487

488 ;(defvar yahtml-struct-name-regexp

490 (defvar yahtml-struct-name-regexp

491 (concat

492 "\\<\\("

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

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

495 "\\)\\b")

496 "Regexp of structure beginning.")

497

498 (defvar yahtml-closable-regexp

499 (concat

500 "\\<\\("

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

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

503 "\\)\\b")

504 "Regexp of any closable elemnts.")

505

506 (defvar yahtml-indent-listing-constant t

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

508 T for static indentation depth")

509

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

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

512

513

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

515 (cond

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

517 buffer-file-name)

518 (let ((dir default-directory)

519 charset af ext (ldir "")

520 line

521 (case-fold-search t)

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

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

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

525 (while (and dir

526 (not (string= dir ldir))

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

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

529 (if (file-exists-p af)

530 (save-excursion

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

532 (save-excursion

533 (goto-char (point-min))

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

535 (setq line (buffer-substring

536 (point-beginning-of-line)

537 (point-end-of-line))

538 dir nil)))

539 (kill-buffer (current-buffer))))

540 (if dir

541 (setq ldir dir

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

543 dir (file-name-directory dir))))

544 line

545 ))

546 (t nil))

547 )

548

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

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

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

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

553 (case-fold-search t)

554 line

555 charset)

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

557 (progn

558 (string-match ptn line)

559 (setq charset

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

561 (cond

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

563 (setq charset 2))

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

565 (setq charset 3))

566 ((string-match "shift_jis" charset)

567 (setq charset 1))

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

569 (setq charset 4))

570 (t (setq charset nil)))

571 (setq dir "")))

572 (if (featurep 'mule)

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

574 charset))

575

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

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

578 x index-list)

579 ;;s/\\s *$//;

580 (if line

581 (progn

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

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

584 (while (string< "" line)

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

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

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

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

589 line ""))

590 )

591 (or (nreverse index-list)

592 (if (listp yahtml-directory-index)

593 yahtml-directory-index

594 (list yahtml-directory-index)))))))

595

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

597 (defun yahtml-mode ()

598 (interactive)

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

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

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

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

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

604 (cond

605 ((null coding) nil)

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

607 (setq buffer-file-coding-system

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

609 (save-excursion

610 (goto-char (point-min))

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

612 coding)))

613 ((featurep 'mule)

614 (set-file-coding-system coding))

615 ((boundp 'NEMACS)

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

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

618 (setq major-mode 'yahtml-mode

619 mode-name "yahtml"

620 YaTeX-current-file-name (file-name-nondirectory

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

622 local-abbrev-table yahtml-mode-abbrev-table)

623 (mapcar

624 (function (lambda (x)

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

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

627 (boundp (cdr x)))

628 (symbol-value (cdr x))

629 (cdr x)))))

630 '((YaTeX-ec . "")

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

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

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

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

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

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

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

638 (paragraph-start . yahtml-paragraph-start)

639 (paragraph-separate . yahtml-paragraph-separate)

640 (comment-start . "")

641 (comment-start-skip . comment-start)

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

643

644 (if yahtml-use-font-lock

645 (progn

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

647 (or (featurep 'xemacs)

648 (progn

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

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

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

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

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

654 (font-lock-fontify-buffer)

655 ))

656 ))

657 (set-syntax-table yahtml-syntax-table)

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

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

660 (yahtml-css-scan-styles)

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

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

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

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

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

666

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

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

669 font-lock-defaults)

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

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

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

673

674 (defun yahtml-version ()

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

676 (interactive)

677 (message

678 (concat "Yet Another HTML-mode "

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

680 " Revision "

681 yahtml-revision-number)))

682

683 (defun yahtml-quit ()

684 (interactive)

685 (and yahtml-mode-old-mode

686 (fboundp yahtml-mode-old-mode)

687 (funcall yahtml-mode-old-mode)))

688

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

690 (cond

691 ((featurep 'xemacs)

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

693 (set keymap nil)

694 (mapcar

695 (function

696 (lambda (bind)

697 (setq bind (cdr bind))

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

699 (setcar (cdr bind) 'progn))

700 (if (stringp (car (cdr bind)))

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

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

703 (symbol-value keymap))))))

704 bindlist)

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

706 (t

707 (mapcar

708 (function

709 (lambda (bind)

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

711 bindlist))))

712

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

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

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

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

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

718

719 ;;; Variables for mosaic url history

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

721 (defvar yahtml-urls-private nil)

722 (defvar yahtml-urls-local nil)

723

724 (cond

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

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

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

728 (YaTeX-define-menu

729 'yahtml-menu-map-sectioning

730 (nreverse

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

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

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

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

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

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

737 )))

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

739 (YaTeX-define-menu

740 'yahtml-menu-map-logical

741 (nreverse

742 '((em "Embolden" .

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

744 (dfn "Define a word" .

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

746 (cite "Citation" .

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

748 (code "Code" .

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

750 (kbd "Keyboard" .

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

752 (samp "Sample display" .

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

754 (strong "Strong" .

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

756 (VAR "Variable notation" .

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

758 )))

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

760 (YaTeX-define-menu

761 'yahtml-menu-map-typeface

762 (nreverse

763 '((b "Bold" .

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

765 (i "Italic" .

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

767 (tt "Typewriter" .

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

769 (u "Underlined" .

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

771 )))

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

773 (YaTeX-define-menu

774 'yahtml-menu-map-listing

775 (nreverse

776 '((ul "Unordered" .

777 (lambda () (interactive) (yahtml-insert-begend nil "UL")))

778 (ol "Ordered" .

779 (lambda () (interactive) (yahtml-insert-begend nil "OL")))

780 (dl "Definition" .

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

782 )))

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

784 (YaTeX-define-menu

785 'yahtml-menu-map-item

786 (nreverse

787 '((li "Simple item" .

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

789 (dt "Define term" .

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

791 (dd "Description of term" .

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

793 )))

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

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

796 (YaTeX-define-menu

797 'yahtml-menu-map

798 (nreverse

799 (list

800 (cons (list 'sect "Sectioning")

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

802 (cons (list 'list "Listing")

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

804 (cons (list 'item "Item")

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

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

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

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

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

810 )))

811 (if (featurep 'xemacs)

812 (add-hook 'yahtml-mode-hook

813 '(lambda ()

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

815 (progn

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

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

818 ))

819

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

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

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

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

824 (interactive "P")

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

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

827 (cmd

828 (or env

829 (YaTeX-cplread-with-learning

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

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

832 (bolp (save-excursion

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

834 (cc (current-column)))

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

836 (setq yahtml-last-begend

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

838 yahtml-last-begend))

839 (setq cmd yahtml-last-begend)

840 (if yahtml-prefer-upcases (setq cmd (upcase cmd)))

841 (if region

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

843 ;; to enable continuous regioning by another environment

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

845 (end (region-end))

846 (addin (yahtml-addin cmd)))

847 (save-excursion

848 (goto-char end)

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

850 (goto-char beg)

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

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

853 (save-excursion

854 (insert "\n")

855 (indent-to-column cc)

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

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

858 (newline)

859 (yahtml-intelligent-newline nil))

860 (yahtml-indent-line))))

861

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

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

864 (interactive)

865 (yahtml-insert-begend t))

866

867

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

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

870 (interactive)

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

872 (or form

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

874 (setq form

875 (YaTeX-cplread-with-learning

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

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

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

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

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

881 (setq yahtml-last-form form)

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

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

884 ;;(indent-relative-maybe)

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

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

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

888

889 (defun yahtml-read-css (alist)

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

891 (minibuffer-completion-table alist))

892 (read-from-minibuffer

893 (substitute-command-keys

894 (if YaTeX-japan

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

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

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

898

899 ;;; ---------- Add-in ----------

900 (defun yahtml-addin (form)

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

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

903 (concat

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

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

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

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

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

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

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

911 (string< "" s))

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

913 ""))))

914

915 (defvar yahtml-completing-buffer nil)

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

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

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

919 (let (list end)

920 (save-excursion

921 (set-buffer yahtml-completing-buffer)

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

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

924 (save-excursion

925 (goto-char (point-min))

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

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

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

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

930 (setq end (match-end 0))

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

932 (yahtml-on-assignment-p)

933 (progn

934 (goto-char end)

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

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

937 (setq list (cons

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

939 list))))

940 list)))

941 )

942

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

944 (if yahtml-url-completion-map nil

945 (setq yahtml-url-completion-map

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

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

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

949 )

950

951 (defun yahtml-complete-url ()

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

953 (interactive)

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

955 (lim (YaTeX-minibuffer-begin))

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

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

958 (cond

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

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

961 listfunc (list 'lambda nil

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

963 beg min))

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

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

966 (progn

967 (setq path (substring initial 0 beg))

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

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

970 (setq initial (substring initial beg))

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

972 cmpl (try-completion initial labels)

973 listfunc (list 'lambda ()

974 (list 'all-completions

975 initial (list 'quote labels)))

976 beg (+ min beg)))

977 (t

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

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

980 initial))

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

982 file (file-name-nondirectory path)

983 initial file

984 cmpl (file-name-completion file dir)

985 listfunc (list 'lambda nil

986 (list 'file-name-all-completions

987 file dir))

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

989 (cond

990 ((stringp cmpl)

991 (if (string= initial cmpl)

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

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

994 (princ

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

996 (delete-region (point) beg)

997 (insert cmpl)))

998 ((null cmpl)

999 (ding))

1000 ((eq t cmpl)

1001 (save-excursion

1002 (unwind-protect

1003 (progn

1004 (goto-char p)

1005 (insert " [Sole completion]"))

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

1007

1008 ;

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

1010 ; From: Masayasu Ishikawa <mimasa@sfc.keio.ac.jp>

1011 ; To: yatex@arcadia.jaist.ac.jp

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

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

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

1015 ;

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

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

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

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

1020 (defvar yahtml-unsafe-chars-regexp

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

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

1023 ;

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

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

1026 ;

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

1028 ; "$" | ","

1029 (defvar yahtml-unreserved-chars-regexp

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

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

1032 Not used yet.")

1033

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

1035 "Translate reserved chars to URL encoded string."

1036 (let ((p 0) (target "")

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

1038 (cond

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

1040 (t

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

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

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

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

1045 (setq target (concat target

1046 (substring str 0 p)

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

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

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

1050 (concat target str)))))

1051

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

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

1054 (interactive "r")

1055 (save-excursion

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

1057 (goto-char beg)

1058 (while (and (< (point) e)

1059 (re-search-forward

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

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

1062 (sit-for 0)

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

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

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

1066 ; (unwind-protect

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

1068 ; (save-excursion

1069 ; (backward-char 1)

1070 ; (delete-backward-char 4))

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

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

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

1074 (progn

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

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

1077 (set-marker e nil))))

1078 ;; ab%defgls/.|

1079

1080 (defun yahtml:a ()

1081 "Add-in function for <a>"

1082 (let ((href ""))

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

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

1085 href (yahtml-escape-chars-string

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

1087 (prog1

1088 (concat (yahtml-make-optional-argument

1089 "href" href)

1090 (yahtml-make-optional-argument

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

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

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

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

1095 (YaTeX-update-table

1096 (list href)

1097 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

1098 )))

1099

1100 (defvar yahtml-parameters-completion-alist

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

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

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

1104 ("src" . file) ("file" . file)

1105 ("background" . file)

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

1107 ("method" ("POST") ("GET"))

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

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

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

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

1112 ("http-equiv" ("Refresh"))))

1113

1114 (defvar yahtml-link-types-alist

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

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

1117 ("subsection") ("appendix") ("help") ("bookmark")))

1118

1119 (defvar yahtml-content-types-alist

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

1121 ("text/sgml") ("text/xml")

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

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

1124 ("application/java")

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

1126 "Alist of content-types")

1127

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

1129 (let* ((alist

1130 (cdr-safe (assoc (downcase par)

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

1132 (prompt (concat par ": "))

1133 v)

1134 (cond

1135 ((eq alist 'file)

1136 (let ((insert-default-directory))

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

1138 ((and alist (symbolp alist))

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

1140 (alist

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

1142 (t

1143 (read-string prompt default)))))

1144

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

1146 "Make optional argument string."

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

1148 ""

1149 (concat " "

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

1151 "=\"" arg "\"")))

1152

1153 (defun yahtml:html ()

1154 "Add-in for <html>"

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

1156 (yahtml-make-optional-argument

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

1158

1159 (defun yahtml:head ()

1160 "Add-in for <head>"

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

1162 "")

1163

1164 (defun yahtml:body ()

1165 "Add-in function for <body>"

1166 (cond

1167 (yahtml-html4-strict nil)

1168 (t

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

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

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

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

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

1174 (concat

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

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

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

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

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

1180

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

1182 "Make CSS property definitions in style attribute."

1183 (mapconcat

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

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

1186 (delq nil proplist)

1187 " "))

1188

1189 (defun yahtml:img ()

1190 "Add-in function for <img>"

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

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

1193 alt

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

1195 (l yahtml-prefer-upcase-attributes)

1196 info width height bytes comments)

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

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

1199 (car info)

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

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

1202 bytes (car (cdr (cdr info)))

1203 comments (nth 4 info)))

1204 (if info

1205 (setq alt

1206 (YaTeX-replace-formats

1207 yahtml:img-default-alt-format

1208 (list (cons "x" width)

1209 (cons "y" height)

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

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

1212 (cons "c" (car comments))))))

1213

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

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

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

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

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

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

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

1221 (if yahtml-html4-strict

1222 (yahtml-make-optional-argument

1223 "style"

1224 (if (or brd alg)

1225 (yahtml-make-style-parameter

1226 (list

1227 (if (string< "" alg)

1228 (cons "align" alg))

1229 (if (string< "" brd)

1230 (cons "border"

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

1232 (concat

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

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

1235

1236 (defun yahtml-file-truename (file)

1237 (cond

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

1239 (t (let ((new file))

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

1241 (not (equal new file)))

1242 (setq file new))

1243 file))))

1244

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

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

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

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

1249 (let ((mlt 1)

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

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

1252 (value 0))

1253 (while (> length 0)

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

1255 pos (+ pos direc)

1256 mlt (* mlt 256)

1257 length (1- length)))

1258 value))

1259

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

1261 "Return the information on the image file FILE.

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

1263 (save-excursion

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

1265 width height bytes depth comment

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

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

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

1269 (seekpoint 1)

1270 c1 c2 c3 c4 beg end

1271 (case-fold-search nil))

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

1273 (set-buffer tmpbuf)

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

1275 (erase-buffer)

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

1277 (unwind-protect

1278 (progn

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

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

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

1282 (YaTeX-insert-file-contents

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

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

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

1286 c2 (char-after 2)

1287 c3 (char-after 3)

1288 c4 (char-after 4))

1289 (cond

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

1291 ;;JPEG images need JPEG markers inspection

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

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

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

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

1296 (catch 'exit

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

1298 (cond

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

1300 ;maybe corrupted, exit from loop

1301 (throw 'exit t))

1302 ((memq

1303 (char-after (1+ seekpoint))

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

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

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

1307 ;;found!

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

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

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

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

1312 ;; JPEG comment area

1313 (setq beg (+ seekpoint 2 2)

1314 end (+ seekpoint

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

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

1317 (t ;other markers

1318 nil)) ;just skip it

1319 (setq seekpoint (+ seekpoint 2)

1320 seekpoint (+ seekpoint

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

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

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

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

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

1326 height (yahtml-hex-value 20 4)

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

1328 ((looking-at "GIF8")

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

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

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

1332 ((looking-at "BM")

1333 ;;# OS/2, Windoze BMP files

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

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

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

1337 (cond

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

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

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

1341 (t

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

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

1344 ))

1345 (message "")

1346 (kill-buffer tmpbuf))

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

1348

1349 (defun yahtml:form ()

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

1351 (concat

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

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

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

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

1356 ))

1357

1358 (defun yahtml:select ()

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

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

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

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

1363

1364 (defun yahtml:ol ()

1365 "Add-in function for <ol>"

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

1367 (let ((start (read-string "start="))

1368 (type (completing-read

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

1370 (concat

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

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

1373 (defun yahtml:ul ()

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

1375 (defun yahtml:dl ()

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

1377 (defun yahtml:dt ()

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

1379

1380 (defun yahtml:p ()

1381 (if yahtml-html4-strict nil

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

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

1384

1385 (defvar yahtml-input-types

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

1387 ("reset") ("image") ("hidden") ("file")))

1388

1389 (defun yahtml:input ()

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

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

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

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

1394 type (completing-read "type (default=text): "

1395 yahtml-input-types nil t)

1396 value (read-string "value: "))

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

1398 (setq size (read-string "size: ")

1399 maxlength (read-string "maxlength: ")))

1400 (concat

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

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

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

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

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

1406 )))

1407

1408 (defun yahtml:textarea ()

1409 "Add-in function for `textarea'"

1410 (interactive)

1411 (let (name rows cols)

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

1413 cols (read-string "Columns: ")

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

1415 (concat

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

1417 "\"" name "\"")

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

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

1420

1421 (defun yahtml:table ()

1422 "Add-in function for `table'"

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

1424 (a (yahtml-read-parameter

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

1426 (if yahtml-html4-strict

1427 (yahtml-make-optional-argument

1428 "style"

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

1430 (yahtml-make-style-parameter

1431 (append

1432 (if (string< "" b)

1433 (list

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

1435 (cons "border-collapse" "collapse")))

1436 (if (string< "" a)

1437 (cond

1438 ((string-match "right" a)

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

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

1441 ((string-match "center" a)

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

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

1444 (concat

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

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

1447

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

1449 (defun yahtml:caption ()

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

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

1452 (if yahtml-html4-strict

1453 (yahtml-make-optional-argument

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

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

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

1457

1458 (defun yahtml:font ()

1459 "Add-in function for `font'"

1460 (concat

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

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

1463

1464 (defun yahtml:style ()

1465 "Add-in function for `style'"

1466 (yahtml-make-optional-argument

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

1468

1469 (defun yahtml:script ()

1470 "Add-in function for `script'"

1471 (concat

1472 (yahtml-make-optional-argument

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

1474 (yahtml-make-optional-argument

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

1476

1477 (defun yahtml:tr ()

1478 "Add-in function for `tr'"

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

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

1481 "")

1482

1483 (defun yahtml:link ()

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

1485 (let (rel rev type href)

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

1487 (cond

1488 ((equal rel "")

1489 (concat (yahtml-make-optional-argument

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

1491 (yahtml-make-optional-argument

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

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

1494 )))

1495 ((string-match "stylesheet" rel)

1496 (concat

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

1498 (yahtml-make-optional-argument

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

1500 (progn

1501 (setq href

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

1503 (if (string< "" href)

1504 (progn

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

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

1507 (setq yahtml-css-class-alist

1508 (yahtml-css-collect-classes-file

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

1510 (message "")

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

1512 (t

1513 (concat

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

1515 (yahtml-make-optional-argument

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

1517 (yahtml-make-optional-argument

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

1519 )))))

1520

1521 (defvar yahtml:meta-names

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

1523

1524 (defun yahtml:meta ()

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

1526 "name"

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

1528 http-equiv content)

1529 (if (string= "" name)

1530 (if (string-match

1531 "Content-type"

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

1533 "http-equiv"

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

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

1536 "See docs/qanda")

1537 (concat http-equiv

1538 (yahtml-make-optional-argument

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

1540 (concat

1541 name

1542 (yahtml-make-optional-argument

1543 "content"

1544 (cond

1545 ((string-match "date" name)

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

1547 ((string-match "author" name)

1548 (read-string "Author: "

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

1550 (user-full-name)

1551 (user-login-name))))

1552 ((string-match "GENERATOR" name)

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

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

1555 (message "Thank you!"))

1556 content)

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

1558

1559 (defun yahtml:br ()

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

1561

1562 (defun yahtml:object ()

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

1564 data classid)

1565 (cond

1566 ((string-match "java" codetype)

1567 (let ((completion-ignored-extensions

1568 ;;any extensions except ".class"

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

1570 (setq classid (concat "java:"

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

1572 (concat

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

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

1575 (yahtml-make-optional-argument

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

1577 (yahtml-make-optional-argument

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

1579 (yahtml-make-optional-argument

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

1581 ))

1582 (t

1583 ""

1584 ))))

1585

1586 (defun yahtml:abbr ()

1587 "Add-in function for abbr."

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

1589

1590 ;;; ---------- Simple tag ----------

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

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

1593 (interactive "P")

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

1595 (or tag

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

1597 (setq tag

1598 (YaTeX-cplread-with-learning

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

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

1601 'yahtml-typeface-table 'yahtml-user-typeface-table

1602 'yahtml-tmp-typeface-table))))

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

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

1605 (setq yahtml-last-typeface-cmd tag

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

1607 (if region-mode

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

1609 (save-excursion

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

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

1612 (exchange-point-and-mark)

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

1614 (message "No mark set now"))

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

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

1617

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

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

1620 (interactive)

1621 (yahtml-insert-tag t tag))

1622

1623

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

1625 (defun yahtml-insert-single (cmd)

1626 "Insert <CMD>."

1627 (interactive

1628 (list

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

1630 (YaTeX-cplread-with-learning

1631 (format "Command%s: "

1632 (if yahtml-last-single-cmd

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

1634 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1637 (setq yahtml-last-single-cmd

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

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

1640 yahtml-last-single-cmd))

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

1642 cmd

1643 (yahtml-addin cmd)

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

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

1646 " /" "")))

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

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

1649

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

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

1652 (interactive "P")

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

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

1655

1656 (defun yahtml-insert-amps (arg)

1657 "Insert char-entity references via ampersand"

1658 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/

1659 (interactive "P")

1660 (let*((mess "") c

1661 (list (append yahtml-entity-reference-chars-alist-default

1662 yahtml-entity-reference-chars-alist))

1663 (l list))

1664 (while l

1665 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))

1666 l (cdr l)))

1667 (message "Char-entity reference: %s SPC=& RET=&; Other=&#..;" mess)

1668 (setq c (read-char))

1669 (cond

1670 ((equal c (car-safe (assoc c list)))

1671 (insert (format "&%s;" (cdr (assoc c list)))))

1672 ((or (equal c ?\n) (equal c ?\r))

1673 (insert "&;")

1674 (forward-char -1))

1675 ((equal c ? )

1676 (insert ?&))

1677 (t (insert (format "&#%d;" c))))))

1678

1679 (defun yahtml:!--\#include ()

1680 (let ((file (yahtml-read-parameter "file" "")))

1681 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1682

1683 (defun yahtml:!--\#exec ()

1684 (format "cmd=\"%s\"--" (yahtml-read-parameter "cmd" "" '(("cmd" . file)))))

1685

1686 ;;; ---------- Jump ----------

1687 (defun yahtml-on-href-p ()

1688 "Check if point is on href clause."

1689 (let ((p (point)) e cmd (case-fold-search t))

1690 (save-excursion

1691 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした

1692 (save-excursion

1693 ;;(search-forward "</a>" nil t) ;aでなくても許可にした

1694 (search-forward "[\" \t\n]" nil t)

1695 (setq e (point)))

1696 ;(goto-char (get 'YaTeX-inner-environment 'point))

1697 (re-search-backward "<\$a\\|link\$\\>" nil t)

1698 (search-forward "href" e t)

1699 (search-forward "=" e t)

1700 (progn

1701 (skip-chars-forward " \t\n")

1702 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

1703 (< p (match-end 0))

1704 (YaTeX-match-string 1)

1705 ))))

1706

1707 (defun yahtml-netscape-sentinel (proc mes)

1708 (cond

1709 ((null (buffer-name (process-buffer proc)))

1710 (set-process-buffer proc nil))

1711 ((eq (process-status proc) 'exit)

1712 (let ((cb (current-buffer)))

1713 (set-buffer (process-buffer proc))

1714 (goto-char (point-min))

1715 (if (search-forward "not running" nil t)

1716 (progn

1717 (message "Starting netscape...")

1718 (start-process

1719 "browser" (process-buffer proc)

1720 shell-file-name yahtml-shell-command-option

1721 (format "%s \"%s\"" yahtml-www-browser

1722 (get 'yahtml-netscape-sentinel 'url)))

1723 (message "Starting netscape...Done")))

1724 (set-buffer cb)))))

1725

1726 (defvar yahtml-browser-process nil)

1727

1728 (defun yahtml-browse-html (href)

1729 "Call WWW Browser to see HREF."

1730 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1731 (cond

1732 ((string-match "^start\\>" yahtml-www-browser)

1733 (if (get-buffer pb)

1734 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1735 (put 'yahtml-netscape-sentinel 'url href)

1736 (set-process-sentinel

1737 (setq yahtml-browser-process

1738 (start-process

1739 "browser" pb shell-file-name yahtml-shell-command-option

1740 (format "%s \"%s\"" yahtml-www-browser href)))

1741 'yahtml-netscape-sentinel))

1742 ((and (string-match

1743 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

1744 (not (eq system-type 'windows-nt)))

1745 (if (get-buffer pb)

1746 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1747 (put 'yahtml-netscape-sentinel 'url href)

1748 (set-process-sentinel

1749 (setq yahtml-browser-process

1750 (start-process

1751 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1752 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1753 'yahtml-netscape-sentinel))

1754 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1755 (w3-fetch href))

1756 ((stringp yahtml-www-browser)

1757 (if (and yahtml-browser-process

1758 (eq (process-status yahtml-browser-process) 'run))

1759 (message "%s is already running" yahtml-www-browser)

1760 (setq yahtml-browser-process

1761 (start-process

1762 "browser" "* WWW Browser *"

1763 shell-file-name yahtml-shell-command-option

1764 (format "%s \"%s\"" yahtml-www-browser href)))))

1765 (t

1766 (message "Sorry, jump across http is not supported.")))))

1767

1768 (defun yahtml-goto-corresponding-href (&optional other)

1769 "Go to corresponding name."

1770 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1771 (if href

1772 (cond

1773 ((string-match "^\$ht\\|f\$tps?:" href)

1774 (yahtml-browse-html href))

1775 (t (setq file (substring href 0 (string-match "#" href)))

1776 (if (string-match "#" href)

1777 (setq name (substring href (1+ (string-match "#" href)))))

1778 (if (string< "" file)

1779 (progn

1780 (if (string-match "/$" file)

1781 (or (catch 'dirindex

1782 (mapcar

1783 (function

1784 (lambda (f)

1785 (if (file-exists-p (concat file f))

1786 (throw 'dirindex

1787 (setq file (concat file f))))))

1788 (yahtml-get-directory-index))

1789 nil)

1790 (setq file (concat file yahtml-directory-index))))

1791 (if (string-match "^/" file)

1792 (setq file (yahtml-url-to-path file)))

1793 (if other (YaTeX-switch-to-buffer-other-window file)

1794 (YaTeX-switch-to-buffer file))

1795 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1796 (if name

1797 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1798 t)))))

1799

1800 (defun yahtml-jump-to-name (name)

1801 "Jump to html's named tag."

1802 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1803 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1804 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1805 (message "Named tag `%s' not found" (substring href 1))))

1806

1807 (defun yahtml-on-begend-p (&optional p)

1808 "Check if point is on begend clause."

1809 (let ((p (or p (point))) cmd (case-fold-search t))

1810 (save-excursion

1811 (goto-char p)

1812 (if (equal (char-after (point)) ?<) (forward-char 1))

1813 (if (and (re-search-backward "<" nil t)

1814 (looking-at

1815 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1816 "<\$/?[A-Z][A-Z0-9]*\$\\b"

1817 )

1818 (condition-case nil

1819 (forward-list 1)

1820 (error nil))

1821 (< p (point)))

1822 (YaTeX-match-string 1)))))

1823

1824 (defun yahtml-goto-corresponding-begend (&optional noerr)

1825 "Go to corresponding opening/closing tag.

1826 Optional argument NOERR causes no error for unballanced tag."

1827 (let ((cmd (yahtml-on-begend-p)) m0

1828 (p (point)) (case-fold-search t) func str (nest 0))

1829 (cond

1830 (cmd

1831 (setq m0 (match-beginning 0))

1832 (if (= (aref cmd 0) ?/) ;on </cmd> line

1833 (setq cmd (substring cmd 1)

1834 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1835 func 're-search-backward)

1836 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1837 func 're-search-forward))

1838 (while (and (>= nest 0) (funcall func str nil t))

1839 (if (equal m0 (match-beginning 0))

1840 nil

1841 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1842 (if (< nest 0)

1843 (goto-char (match-beginning 0))

1844 (funcall

1845 (if noerr 'message 'error)

1846 "Corresponding tag of `%s' not found." cmd)

1847 (goto-char p)

1848 nil))

1849 (t nil))))

1850

1851 (defun yahtml-current-tag ()

1852 "Return the current tag name including #exec and #include."

1853 (save-excursion

1854 (let ((p (point)) b tag)

1855 (or (bobp)

1856 (looking-at "<")

1857 (progn (skip-chars-backward "^<") (forward-char -1)))

1858 (setq b (point))

1859 (skip-chars-forward "<")

1860 (setq tag (YaTeX-buffer-substring

1861 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1862 (goto-char b)

1863 (forward-list 1)

1864 (and (< p (point)) tag))))

1865

1866 (defun yahtml-get-attrvalue (attr)

1867 "Extract current tag's attribute value from buffer."

1868 (let (e (case-fold-search t))

1869 (save-excursion

1870 (or (looking-at "<")

1871 (progn (skip-chars-backward "^<") (backward-char 1)))

1872 (setq e (save-excursion (forward-list 1) (point)))

1873 (if (and

1874 (re-search-forward (concat "\\b" attr "\\b") e t)

1875 (progn (skip-chars-forward " \t\n=")

1876 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1877 (YaTeX-match-string 1)))))

1878

1879 (defun yahtml-goto-corresponding-img ()

1880 "View image on point"

1881 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1882 (if (and tag

1883 (string-match "img" tag)

1884 (setq image (yahtml-get-attrvalue "src")))

1885 (progn

1886 (message "Invoking %s %s..." yahtml-image-viewer image)

1887 (start-process

1888 "Viewer" " * Image Viewer *"

1889 shell-file-name yahtml-shell-command-option ;"-c"

1890 (concat yahtml-image-viewer " " image))

1891 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1892

1893 (defun yahtml-goto-corresponding-source (&optional other)

1894 "Goto applet's or script's source."

1895 (let ((env (yahtml-current-tag)) s (p (point)))

1896 (cond

1897 ((string-match "applet" env)

1898 (if (setq s (yahtml-get-attrvalue "code"))

1899 (progn

1900 (setq s (YaTeX-match-string 1)

1901 s (concat

1902 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1903 ".java"))

1904 (if other (YaTeX-switch-to-buffer-other-window s)

1905 (YaTeX-switch-to-buffer s))

1906 s) ;return source file name

1907 (message "No applet source specified")

1908 (sit-for 1)

1909 nil))

1910 ((string-match "script" env)

1911 (if (setq s (yahtml-get-attrvalue "src"))

1912 (progn

1913 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1914 'YaTeX-switch-to-buffer)

1915 (yahtml-url-to-path s))

1916 s)))

1917 ((string-match "!--#include" env)

1918 (cond

1919 ((setq s (yahtml-get-attrvalue "file")) ;

1920 (if other (YaTeX-switch-to-buffer-other-window s)

1921 (YaTeX-switch-to-buffer s))

1922 s)

1923 ((setq s (yahtml-get-attrvalue "virtual"));

1924 (setq s (yahtml-url-to-path s))

1925 (if other (YaTeX-switch-to-buffer-other-window s)

1926 (YaTeX-switch-to-buffer s))

1927 s)))

1928 ((and (string-match "!--#exec" env)

1929 (setq s (yahtml-get-attrvalue "cmd")))

1930 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1931 (let ((b " *yahtmltmp*")) ;peek a little

1932 (unwind-protect

1933 (progn

1934 (set-buffer (get-buffer-create b))

1935 (YaTeX-insert-file-contents s nil 0 100)

1936 (if (looking-at "#!")

1937 (if other (YaTeX-switch-to-buffer-other-window s)

1938 (YaTeX-switch-to-buffer s))))

1939 (kill-buffer (get-buffer b)))

1940 (get-file-buffer s))))))

1941

1942 (defun yahtml-goto-corresponding-* (&optional other)

1943 "Go to corresponding object."

1944 (interactive "P")

1945 (cond

1946 ((yahtml-goto-corresponding-href other))

1947 ((yahtml-goto-corresponding-img))

1948 ((yahtml-goto-corresponding-source other))

1949 ((yahtml-goto-corresponding-begend))

1950 (t (message "I don't know where to go."))

1951 ))

1952

1953 (defun yahtml-goto-corresponding-*-other-window ()

1954 "Go to corresponding object."

1955 (interactive)

1956 (yahtml-goto-corresponding-* t))

1957

1958 (defun yahtml-visit-main ()

1959 "Go to parent file from where you visit current file."

1960 (interactive)

1961 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1962

1963 ;;; ---------- killing ----------

1964 (defun yahtml-kill-begend (&optional whole)

1965 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1966 (if tag

1967 (save-excursion

1968 (or (looking-at "<")

1969 (progn (skip-chars-backward "^<") (forward-char -1)))

1970 (setq p (point))

1971 (yahtml-goto-corresponding-begend)

1972 (or (looking-at "<")

1973 (progn (skip-chars-backward "^<") (forward-char -1)))

1974 (if (< (point) p) ;if on the opening tag

1975 (progn (setq q p p (point))

1976 (goto-char q))

1977 (setq q (point))) ;now q has end-line's (point)

1978 (if (not whole)

1979 (kill-region

1980 (progn (skip-chars-backward " \t")

1981 (if (setq bbolp (bolp)) (point) q))

1982 (progn (forward-list 1)

1983 (setq r (point))

1984 (skip-chars-forward " \t")

1985 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1986 (goto-char p)

1987 (skip-chars-backward " \t")

1988 (if (not whole)

1989 (progn

1990 (kill-append

1991 (buffer-substring

1992 (setq p (if (setq bbolp (bolp)) (point) p))

1993 (setq q (progn

1994 (forward-list 1)

1995 (setq r (point))

1996 (skip-chars-forward " \t")

1997 (if (and bbolp (eolp) (not (eobp)))

1998 (1+ (point))

1999 r))))

2000 t)

2001 (delete-region p q))

2002 (kill-region

2003 (if (bolp) (point) p)

2004 (progn (goto-char q)

2005 (forward-list 1)

2006 (setq r (point))

2007 (skip-chars-forward " \t")

2008 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2009 tag))))

2010

2011 (defun yahtml-kill-* (whole)

2012 "Kill current position's HTML tag (set)."

2013 (interactive "P")

2014 (cond

2015 ((yahtml-kill-begend whole))

2016 ))

2017

2018

2019 ;;; ---------- changing ----------

2020 (defun yahtml-on-assignment-p ()

2021 "Return if current point is on parameter assignment.

2022 If so, return parameter name, otherwise nil.

2023 This function should be able to treat white spaces in value, but not yet."

2024 (let ((p (point)))

2025 (save-excursion

2026 (put 'yahtml-on-assignment-p 'region nil)

2027 (skip-chars-backward "^ \t\n")

2028 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2029 (< p (match-end 0))

2030 (>= p (1- (match-beginning 2)))

2031 (put 'yahtml-on-assignment-p 'region

2032 (cons (match-beginning 2) (match-end 2)))

2033 (YaTeX-match-string 1)))))

2034

2035 (defun yahtml-change-begend ()

2036 (let ((tag (yahtml-on-begend-p))

2037 (completion-ignore-case t)

2038 (case-fold-search t)

2039 (p (point)) (q (make-marker))

2040 (default (append yahtml-env-table yahtml-typeface-table))

2041 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2042 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2043 href b1 e1 attr new css)

2044 (cond

2045 (tag

2046 (cond

2047 ((and (string-match "^a$" tag)

2048 (save-excursion

2049 (and

2050 (re-search-backward "<a\\b" nil t)

2051 (progn

2052 (goto-char (match-end 0))

2053 (skip-chars-forward " \t\n")

2054 (setq b1 (point))

2055 (search-forward ">" nil t))

2056 (setq e1 (match-beginning 0))

2057 (goto-char b1)

2058 (re-search-forward "href\\s *=" e1 t)

2059 (>= p (point))

2060 (progn

2061 (goto-char (match-end 0))

2062 (skip-chars-forward " \t\n")

2063 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2064 (< p (match-end 0)))))

2065 (setq b1 (match-beginning 1) e1 (match-end 1)

2066 yahtml-completing-buffer (current-buffer)

2067 ;; yahtml-urls-local is buffer-local, so we must put

2068 ;; that into yahtml-urls here

2069 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2070 href (read-from-minibuffer

2071 "Change href to: " "" yahtml-url-completion-map))

2072 (if (string< "" href)

2073 (progn

2074 ;;(setq href ;??

2075 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2076 (delete-region b1 e1)

2077 (goto-char b1)

2078 (insert href))))

2079 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2080 (if (and (equal attr "class") ;treat "class" attribute specially

2081 (setq css (yahtml-css-get-element-completion-alist tag)))

2082

2083 (setq new (yahtml-read-css css))

2084 ;;other than "class", read parameter normally

2085 (setq new (yahtml-read-parameter attr)))

2086 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2087 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2088 (insert new))

2089 (t

2090 (save-excursion

2091 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2092 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2093 (skip-chars-forward "^A-Za-z")

2094 (set-marker q (point))

2095 (setq p (point))

2096 (yahtml-goto-corresponding-begend)

2097 (or (= (char-after (point)) ?<)

2098 (skip-chars-backward "^<"))

2099 (skip-chars-forward "^A-Za-z")

2100 (if (= (char-after (1- (point))) ?/)

2101 (progn

2102 (set-marker q (point))

2103 (goto-char p)))

2104 (setq tag (let ((completion-ignore-case t))

2105 (YaTeX-cplread-with-learning

2106 (format "Change `%s' to(default %s): "

2107 tag yahtml-last-begend)

2108 'default 'user 'tmp)))

2109 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2110 (if (string= "" tag) (setq tag yahtml-last-begend))

2111 (setq yahtml-last-begend

2112 (or (cdr (assoc tag yahtml-env-table)) tag)

2113 tag yahtml-last-begend)

2114 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2115 (insert (format "%s%s" tag (yahtml-addin tag)))

2116 (goto-char q)

2117 (set-marker q nil)

2118 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2119 (insert tag))))

2120 t))))

2121

2122 (defun yahtml-change-command ()

2123 (let ((p (point)) (case-fold-search t) cmd par new

2124 (beg (make-marker)) (end (make-marker)))

2125 (skip-chars-backward "^<")

2126 (if (and

2127 (looking-at yahtml-command-regexp)

2128 (progn

2129 (set-marker beg (match-beginning 0))

2130 (set-marker end (match-end 0))

2131 t) ;for further work

2132 (progn

2133 (forward-char -1)

2134 (condition-case nil

2135 (forward-list 1)

2136 (error nil))

2137 (< p (point))))

2138 (progn

2139 (goto-char p)

2140 (if (setq par (yahtml-on-assignment-p))

2141 (progn

2142 (setq new (yahtml-read-parameter par))

2143 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2144 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2145 (setq new

2146 (YaTeX-cplread-with-learning

2147 "Change form to: "

2148 'yahtml-form-table 'yahtml-user-form-table

2149 'yahtml-tmp-form-table)))

2150 (delete-region beg end)

2151 (goto-char beg)

2152 (set-marker beg nil)

2153 (set-marker end nil)

2154 (insert new)

2155 t)

2156 (goto-char p)

2157 nil)))

2158

2159 (defun yahtml-change-* ()

2160 "Change current position's HTML tag (set)."

2161 (interactive)

2162 (cond

2163 ((yahtml-change-begend))

2164 ((yahtml-change-command))

2165 ))

2166

2167 ;;; ---------- commenting ----------

2168

2169 (defun yahtml-comment-region (&optional uncom)

2170 "Comment out region or environment."

2171 (interactive)

2172 (let ((e (make-marker)) be beg p)

2173 (cond

2174 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2175 (setq be (yahtml-on-begend-p))

2176 (save-excursion

2177 (setq p (point))

2178 (if (string-match "^/" be)

2179 (setq beg (progn (forward-line 1) (point)))

2180 (setq beg (progn (beginning-of-line) (point))))

2181 (goto-char p)

2182 (yahtml-goto-corresponding-begend)

2183 (if (string-match "^/" be)

2184 (beginning-of-line)

2185 (forward-line 1))

2186 (set-marker e (point))

2187 ;(comment-region beg (point) (if uncom (list 4)))

2188 ))

2189 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2190 (setq beg (region-beginning))

2191 (set-marker e (region-end))))

2192 (if yahtml-translate-hyphens-when-comment-region

2193 (let ((yahtml-entity-reference-chars-alist-default nil)

2194 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2195 yahtml-entity-reference-chars-regexp

2196 yahtml-entity-reference-chars-reverse-regexp)

2197 (yahtml-entity-reference-chars-setup)

2198 (funcall

2199 (if uncom 'yahtml-translate-reverse-region

2200 'yahtml-translate-region)

2201 beg e)))

2202 (comment-region beg e (if uncom (list 4)))

2203 (set-marker e nil)))

2204

2205 (defun yahtml-uncomment-region ()

2206 (interactive)

2207 (yahtml-comment-region t))

2208

2209 ;;; ---------- translate to entity references ----------

2210 (defvar yahtml-entity-reference-chars-alist-default

2211 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2212 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2213 "Default translation table from character to entity reference")

2214 (defvar yahtml-entity-reference-chars-alist nil

2215 "*Translation table from character to entity reference")

2216 (defvar yahtml-entity-reference-chars-regexp nil)

2217 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2218

2219 (defun yahtml-entity-reference-chars-setup ()

2220 (let ((list (append yahtml-entity-reference-chars-alist-default

2221 yahtml-entity-reference-chars-alist)))

2222 (setq yahtml-entity-reference-chars-regexp "["

2223 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2224 (while list

2225 (setq yahtml-entity-reference-chars-regexp

2226 (concat yahtml-entity-reference-chars-regexp

2227 (char-to-string (car (car list))))

2228 yahtml-entity-reference-chars-reverse-regexp

2229 (concat yahtml-entity-reference-chars-reverse-regexp

2230 (cdr (car list))

2231 (if (cdr list) "\\|")))

2232 (setq list (cdr list)))

2233 (setq yahtml-entity-reference-chars-regexp

2234 (concat yahtml-entity-reference-chars-regexp "]")

2235 yahtml-entity-reference-chars-reverse-regexp

2236 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2237

2238 (yahtml-entity-reference-chars-setup)

2239

2240 (defun yahtml-translate-region (beg end)

2241 "Translate inhibited literals."

2242 (interactive "r")

2243 (save-excursion

2244 (save-restriction

2245 (narrow-to-region beg end)

2246 (let ((ct (append yahtml-entity-reference-chars-alist

2247 yahtml-entity-reference-chars-alist-default)))

2248 (goto-char beg)

2249 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2250 ;(setq c (preceding-char))

2251 (replace-match

2252 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2253

2254 (defun yahtml-translate-reverse-region (beg end)

2255 "Translate entity references to literals."

2256 (interactive "r")

2257 (save-excursion

2258 (save-restriction

2259 (narrow-to-region beg end)

2260 (let ((ct (append yahtml-entity-reference-chars-alist

2261 yahtml-entity-reference-chars-alist-default))

2262 ec)

2263 (goto-char beg)

2264 (while (re-search-forward

2265 yahtml-entity-reference-chars-reverse-regexp nil t)

2266 ;(setq c (preceding-char))

2267 (setq ec (YaTeX-match-string 1))

2268 (delete-region (match-end 0) (match-beginning 0))

2269 (insert (car (YaTeX-rassoc ec ct))))))))

2270

2271 (defun yahtml-inner-environment-but (exclude &optional quick)

2272 "Return the inner environment but matches with EXCLUDE tag."

2273 (let (e (case-fold-search t))

2274 (save-excursion

2275 (while (and (setq e (YaTeX-inner-environment quick))

2276 (string-match exclude e))

2277 (goto-char (get 'YaTeX-inner-environment 'point))))

2278 e))

2279

2280 ;;; ---------- filling ----------

2281 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2282 (defun yahtml-move-to-column (col &optional force)

2283 (beginning-of-line)

2284 (let ((ccol 0))

2285 (while (and (> col ccol) (not (eolp)))

2286 (if (eq (following-char) ?\<)

2287 (progn

2288 (while (and (not (eq (following-char) ?\>))

2289 (not (eolp)))

2290 (forward-char))

2291 (or (eolp) (forward-char)))

2292 (or (eolp) (forward-char))

2293 (if (eq (preceding-char) ?\t)

2294 (let ((wd (- 8 (% (+ ccol 8) 8))))

2295 (if (and force (< col (+ ccol wd)))

2296 (progn

2297 (backward-char 1)

2298 (insert-char ?\ (- col ccol))

2299 (setq ccol col))

2300 (setq ccol (+ ccol wd))))

2301 (setq ccol (1+ ccol)))

2302 (if (and YaTeX-japan

2303 (or

2304 (and (fboundp 'char-category)

2305 (string-match "[chj]" (char-category (preceding-char))))

2306 (and (fboundp 'char-charset)

2307 (not (eq (char-charset (preceding-char)) 'ascii)))))

2308 (setq ccol (1+ ccol)))))

2309 (if (and force (> col ccol))

2310 (progn

2311 (insert-char ?\ (- col ccol))

2312 col)

2313 ccol)))

2314

2315 (defun yahtml-fill-paragraph (arg)

2316 (interactive "P")

2317 (let*((case-fold-search t) (p (point)) fill-prefix

2318 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2319 indent

2320 (startp (get 'YaTeX-inner-environment 'point))

2321 (prep (string-match "^pre$" e))

2322 (ps1 (if prep (default-value 'paragraph-start)

2323 paragraph-start))

2324 (ps2 (if prep (concat (default-value 'paragraph-start)

2325 "$\\|^\\s *</?pre>")

2326 paragraph-start)))

2327 (save-excursion

2328 (unwind-protect

2329 (progn

2330 (if prep

2331 (fset 'move-to-column 'yahtml-move-to-column))

2332 (save-excursion

2333 (beginning-of-line)

2334 (indent-to-column (yahtml-this-indent))

2335 (setq fill-prefix

2336 (buffer-substring (point) (point-beginning-of-line)))

2337 (delete-region (point) (point-beginning-of-line)))

2338 (fill-region-as-paragraph

2339 (progn (re-search-backward paragraph-start nil t)

2340 (or (save-excursion

2341 (goto-char (match-beginning 0))

2342 (if (looking-at "<")

2343 (forward-list)

2344 (goto-char (match-end 0))

2345 (skip-chars-forward " \t>"))

2346 (if (looking-at "[ \t]*$")

2347 (progn (forward-line 1) (point))))

2348 (point)))

2349 (progn (goto-char p)

2350 (re-search-forward ps2 nil t)

2351 (match-beginning 0))))

2352 (fset 'move-to-column yahtml-saved-move-to-column)))))

2353

2354 ;(defun yahtml-indent-new-commnet-line ()

2355 ; (unwind-protect

2356 ; (progn

2357 ; (fset 'move-to-column 'yahtml-move-to-column)

2358 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2359 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2360

2361 ;;;

2362 ;;; ---------- indentation ----------

2363 ;;;

2364 (defun yahtml-indent-line ()

2365 "Indent a line (faster wrapper)"

2366 (interactive)

2367 (let (indent)

2368 (if (and (save-excursion

2369 (beginning-of-line) (skip-chars-forward "\t ")

2370 (not (looking-at "<")))

2371 (save-excursion

2372 (forward-line -1)

2373 (while (and (not (bobp)) (looking-at "^\\s *$"))

2374 (forward-line -1))

2375 (skip-chars-forward "\t ")

2376 (setq indent (current-column))

2377 (not (looking-at "<"))))

2378 (progn

2379 (save-excursion

2380 (beginning-of-line)

2381 (skip-chars-forward " \t")

2382 (or (= (current-column) indent)

2383 (YaTeX-reindent indent)))

2384 (and (bolp) (skip-chars-forward " \t")))

2385 (yahtml-indent-line-real))))

2386

2387 (defun yahtml-this-indent ()

2389 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2390 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2391 (excludes

2392 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2393 inenv p col peol (case-fold-search t))

2394 (save-excursion

2395 (beginning-of-line)

2396 (setq inenv (or (yahtml-inner-environment-but excludes t)

2397 "html")

2398 col (get 'YaTeX-inner-environment 'indent)

2399 p (get 'YaTeX-inner-environment 'point)

2400 op nil))

2401 (save-excursion

2402 (cond

2403 ((string-match (concat "^\$" envs "\$") inenv)

2404 (save-excursion

2405 (beginning-of-line)

2406 (skip-chars-forward " \t")

2407 (cond ;lookup current line's tag

2408 ((looking-at (concat "</\$" envs "\$>"))

2409 col)

2410 ((looking-at itms)

2411 (+ col yahtml-environment-indent))

2412 ((and yahtml-hate-too-deep-indentation

2413 (looking-at (concat "<\$" envs "\$")))

2414 (+ col (* 2 yahtml-environment-indent)))

2415 ((and (< p (point))

2416 (string-match itemizing-envs inenv)

2417 (save-excursion

2418 (and

2419 (setq op (point))

2420 (goto-char p)

2421 (re-search-forward itms op t)

2422 (progn

2423 (if yahtml-indent-listing-constant

2424 (setq col (+ (current-column)

2425 (if yahtml-faithful-to-htmllint 1 2)))

2426 (skip-chars-forward "^>")

2427 (skip-chars-forward ">")

2428 (skip-chars-forward " \t")

2429 (setq col (if (looking-at "$")

2430 (+ col yahtml-environment-indent)

2431 (current-column))))))))

2432 col)

2433 (t

2434 (+ col yahtml-environment-indent)))))

2435 (t col)))))

2436

2437 (defun yahtml-indent-line-real ()

2438 "Indent current line."

2439 (interactive)

2440 (YaTeX-reindent (yahtml-this-indent))

2441 (if (bolp) (skip-chars-forward " \t"))

2442 (let (peol col inenv)

2443 (if (and (setq inenv (yahtml-on-begend-p))

2444 (string-match

2445 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2446 (save-excursion

2447 (setq peol (point-end-of-line))

2448 (or (= (char-after (point)) ?<)

2449 (progn (skip-chars-backward "^<") (forward-char -1)))

2450 (setq col (current-column))

2451 (if (and (yahtml-goto-corresponding-begend t)

2452 (> (point) peol)) ;if on the different line

2453 (YaTeX-reindent col))))))

2454

2455 ;(defun yahtml-fill-item ()

2456 ; "Fill item HTML version"

2457 ; (interactive)

2458 ; (let (inenv p fill-prefix peol (case-fold-search t))

2459 ; (setq inenv (or (YaTeX-inner-environment) "html")

2460 ; p (get 'YaTeX-inner-environment 'point))

2461 ; (cond

2462 ; ((string-match "^[uod]l" inenv)

2463 ; (save-excursion

2464 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2465 ; (progn

2466 ; (goto-char (match-end 0))

2467 ; (setq col (current-column)))

2468 ; (error "No <li>, <dt>, <dd>")))

2469 ; (save-excursion

2470 ; (end-of-line)

2471 ; (setq peol (point))

2472 ; (newline)

2473 ; (indent-to-column col)

2474 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2475 ; (delete-region (point) peol)

2476 ; (fill-region-as-paragraph

2477 ; (progn (re-search-backward paragraph-start nil t) (point))

2478 ; (progn (re-search-forward paragraph-start nil t 2)

2479 ; (match-beginning 0)))))

2480 ; (t nil))))

2481

2482 ;;;

2483 ;;; ---------- Lint and Browsing ----------

2484 ;;;

2485 (defun yahtml-browse-menu ()

2486 "Browsing menu"

2487 (interactive)

2488 (message "J)weblint p)Browse R)eload...")

2489 (let ((c (char-to-string (read-char))))

2490 (cond

2491 ((string-match "j" c)

2492 (yahtml-lint-buffer (current-buffer)))

2493 ((string-match "[bp]" c)

2494 (yahtml-browse-current-file))

2495 ((string-match "r" c)

2496 (yahtml-browse-reload)))))

2497

2498 (if (fboundp 'wrap-function-to-control-ime)

2499 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2500

2501 (defvar yahtml-lint-buffer "*weblint*")

2502

2503 (defun yahtml-lint-buffer (buf)

2504 "Call lint on buffer BUF."

2505 (require 'yatexprc)

2506 (interactive "bCall lint on buffer: ")

2507 (setq buf (get-buffer buf))

2508 (YaTeX-save-buffers)

2509 (YaTeX-typeset

2510 (concat yahtml-lint-program " "

2511 (file-name-nondirectory (buffer-file-name buf)))

2512 yahtml-lint-buffer "lint" "lint"))

2513

2514 (defun yahtml-file-to-url (file)

2515 "Convert local unix file name to URL.

2516 If no matches found in yahtml-path-url-alist, return raw file name."

2517 (let ((list yahtml-path-url-alist) p url)

2518 (if (file-directory-p file)

2519 (setq file (expand-file-name yahtml-directory-index file))

2520 (setq file (expand-file-name file)))

2521 (if (string-match "^[A-Za-z]:/" file)

2522 (progn

2523 ;; (aset file 1 ?|) ;これは要らないらしい…

2524 (setq file (concat "///" file))))

2525 (while list

2526 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2527 (setq url (cdr (car list))

2528 file (substring file (match-end 0))

2529 url (concat url file)

2530 list nil))

2531 (setq list (cdr list)))

2532 (or url (concat "file:" file))))

2533

2534 (defun yahtml-url-to-path (file &optional basedir)

2535 "Convert local URL name to unix file name."

2536 (let ((list yahtml-path-url-alist) url realpath docroot

2537 (dirsufp (string-match "/$" file)))

2538 (setq basedir (or basedir

2539 (file-name-directory

2540 (expand-file-name default-directory))))

2541 (cond

2542 ((string-match "^/" file)

2543 (while list

2544 (if (file-directory-p (car (car list)))

2545 (progn

2546 (setq url (cdr (car list)))

2547 (if (string-match "\$http://[^/]*\$/" url)

2548 (setq docroot (substring url (match-end 1)))

2549 (setq docroot url))

2550 (cond

2551 ((string-match (concat "^" (regexp-quote docroot)) file)

2552 (setq realpath

2553 (expand-file-name

2554 (substring

2555 file

2556 (if (= (aref file (1- (match-end 0))) ?/)

2557 (match-end 0) ; "/foo"

2558 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2559 (car (car list))))))

2560 (if realpath

2561 (progn (setq list nil)

2562 (if (and dirsufp (not (string-match "/$" realpath)))

2563 (setq realpath (concat realpath "/")))))))

2564 (setq list (cdr list)))

2565 realpath)

2566 (t file))))

2567

2568 (defun yahtml-browse-current-file ()

2569 "Call WWW browser on current file."

2570 (interactive)

2571 (basic-save-buffer)

2572 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2573

2574 (defun yahtml-browse-reload ()

2575 "Send `reload' event to netzscape."

2576 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2577 (cond

2578 ((string-match "[Nn]etscape" yahtml-www-browser)

2579 (if (get-buffer pb)

2580 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2581 ;;(or (get 'yahtml-netscape-sentinel 'url)

2582 ;; (error "Reload should be called after Browsing."))

2583 (put 'yahtml-netscape-sentinel 'url

2584 (yahtml-file-to-url (buffer-file-name)))

2585 (basic-save-buffer)

2586 (set-process-sentinel

2587 (setq yahtml-browser-process

2588 (start-process

2589 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2590 (format "%s -remote 'reload'" yahtml-www-browser)))

2591 'yahtml-netscape-sentinel))

2592 (t

2593 (message "Sorry, RELOAD is supported only for Netscape.")))))

2594

2595 ;;; ---------- Intelligent newline ----------

2596 (defun yahtml-intelligent-newline (arg)

2597 "Intelligent newline for HTML"

2598 (interactive "P")

2599 (let (env func)

2600 (end-of-line)

2601 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2602 "html")))

2603 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2604 (newline)

2605 (if (and env func (fboundp func))

2606 ;; if intelligent line function is defined, call that

2607 (funcall func)

2608 ;; else do the default action

2609 (if (string-match yahtml-p-prefered-env-regexp env)

2610 (yahtml-insert-p)))))

2611

2612 (defun yahtml-intelligent-newline-ul ()

2613 (interactive)

2614 (yahtml-insert-single "li")

2615 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2616 (yahtml-indent-line))

2617

2618 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2619

2620 (defun yahtml-intelligent-newline-dl ()

2621 (interactive)

2622 (let ((case-fold-search t))

2623 (if (save-excursion

2624 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2625 (get 'YaTeX-inner-environment 'point) t))

2626 (cond

2627 ((match-beginning 2)

2628 (yahtml-insert-single "dd")

2629 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2630 (setq yahtml-last-single-cmd "dt"))

2631 ((match-beginning 3)

2632 (yahtml-insert-single "dt")

2633 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2634 (setq yahtml-last-single-cmd "dd")))

2635 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

2636 (setq yahtml-last-single-cmd "dd"))

2637 (yahtml-indent-line)

2638 (and (string-match yahtml-p-prefered-env-regexp "dl")

2639 (string-equal yahtml-last-single-cmd "dt")

2640 (yahtml-insert-p nil))))

2641

2642 (defun yahtml-intelligent-newline-select ()

2643 (interactive)

2644 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2645 (yahtml-indent-line))

2646

2647 (defun yahtml-intelligent-newline-style ()

2648 (interactive)

2649 (if (save-excursion

2650 (and

2651 (re-search-backward "<style\\|<!-- " nil t)

2652 (looking-at "<style")))

2653 (let (c)

2654 (yahtml-indent-line)

2655 (setq c (current-column))

2656 (insert "<!--\n")

2657 (YaTeX-reindent c)

2658 (insert "-->")

2659 (beginning-of-line)

2660 (open-line 1)

2661 (YaTeX-reindent c))))

2662

2663 (defun yahtml-intelligent-newline-head ()

2664 (let ((title (read-string "Document title: "))

2665 (b "<title>") (e "</title>") p)

2666 (yahtml-indent-line)

2667 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2668 (setq p (point))

2669 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2670 (if (string= "" title) (goto-char p))

2671 (setq yahtml-last-begend "body")))

2672

2673 (defun yahtml-intelligent-newline-script ()

2674 (let ((p (point)) b)

2675 (if (save-excursion

2676 (and

2677 (setq b (re-search-backward "<script\\>" nil t))

2678 (re-search-forward

2679 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2680 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2681 c (srcp (re-search-backward "src=" b t)))

2682 (goto-char p)

2683 (yahtml-indent-line)

2684 (setq c (current-column))

2685 (if srcp

2686 nil

2687 (insert "")

2688 (beginning-of-line)

2689 (open-line 1)

2690 (YaTeX-reindent c))))))

2691

2692 (defun yahtml-intelligent-newline-table ()

2693 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2694 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2695 (cond

2696 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2697 (while (and (setq rb (re-search-backward ptn tb t))

2698 (match-beginning 1))

2699 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2700 (goto-char (match-end 0))

2701 (skip-chars-forward " \t\n")

2702 (if (and (search-forward "colspan\\s *=" p t)

2703 (progn

2704 (skip-chars-forward "\"' \t\n")

2705 (looking-at "[0-9]+")))

2706 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2707 (setq cols (1+ cols)))

2708 (goto-char rb)

2709 (setq p (point)))

2710 (if (> cols 0)

2711 (message "%s columns found. %s"

2712 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2713 "New tr?(N) or Duplicate")))

2714 (cond

2715 ((and (> cols 0)

2716 (memq (read-char) '(?d ?D))) ;Duplication mode

2717 (setq line (YaTeX-buffer-substring (point) cp)))

2718 (t ;empty cells

2719 (setq line "<tr>" i 0)

2720 (if (> cols 0)

2721 (while (> cols i)

2722 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2723 "<td></td>"))

2724 th nil i (1+ i)))

2725 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2726 (while (string-match "t\$h\$\\|td" fmt i)

2727 (setq line (concat line (if (match-beginning 1) "<th></th>"

2728 "<td></td>"))

2729 i (match-end 0))))

2730 (setq line (concat line "</tr>"))))

2731 (goto-char cp)

2732 (if th

2733 (message

2734 "Type `%s' to change td from/to th."

2735 (key-description (car (where-is-internal 'yahtml-change-*)))))

2736 (if (string< "" line)

2737 (progn

2738 (insert line)

2739 (goto-char (+ 8 cp))

2740 (yahtml-indent-line)))))))

2741

2742 ;;; ---------- Marking ----------

2743 (defun yahtml-mark-begend ()

2744 "Mark current tag"

2745 (interactive)

2746 (YaTeX-beginning-of-environment)

2747 (let ((p (point)))

2748 (save-excursion

2749 (skip-chars-backward " \t" (point-beginning-of-line))

2750 (if (bolp) (setq p (point))))

2751 (push-mark p t))

2752 (yahtml-goto-corresponding-begend)

2753 (forward-list 1)

2754 (if (eolp) (forward-char 1)))

2755

2756 ;;; ---------- complete marks ----------

2757 (defun yahtml-complete-mark ()

2758 "Complete &gt, &lt, &ampersand, and &quote."

2759 (interactive)

2760 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2761 (let ((c (read-char)))

2762 (setq c (if (or (< c ?0) (> c ?7))

2763 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2764 (- c ?1)))

2765 (if (or (< c 0) (> c 6))

2766 nil

2767 (insert (format "&%s;"

2768 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2769

2770

2771 ;;; ---------- jump to error line ----------

2772 (defun yahtml-prev-error ()

2773 "Jump to previous error seeing lint buffer."

2774 (interactive)

2775 (or (get-buffer yahtml-lint-buffer)

2776 (error "No lint program ran."))

2777 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2778 (yahtml-jump-to-error-line t))

2779

2780 (defun yahtml-jump-to-error-line (&optional sit)

2781 (interactive "P")

2782 (let ((p (point)) (e (point-end-of-line)))

2783 (end-of-line)

2784 (if (re-search-backward yahtml-error-line-regexp nil t)

2785 (let ((f (if (string= "" (YaTeX-match-string 1))

2786 YaTeX-current-file-name

2787 (YaTeX-match-string 1)))

2788 (l (string-to-int (or (YaTeX-match-string 2)

2789 (YaTeX-match-string 3)))))

2790 (if sit (sit-for 1))

2791 (forward-line -1)

2792 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2793 (goto-line l))

2794 (message "No line number usage"))))

2795

2796 ;;; ---------- Style Sheet Support ----------

2797 (defvar yahtml-css-class-alist nil

2798 "Alist of elements vs. their classes")

2799

2800 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2801 (save-excursion

2802 (save-restriction

2803 (narrow-to-region beg end)

2804 (goto-char (point-min))

2805 (let ((alist initial) b e element class a)

2806 (setq b (point))

2807 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2808 (if (match-beginning 2)

2809 (let ((f (YaTeX-buffer-substring

2810 (progn (skip-chars-forward "^\"")(1+ (point)))

2811 (progn (forward-char 1)

2812 (skip-chars-forward "^\"")(point)))))

2813 (if (file-exists-p f)

2814 (setq alist

2815 (append alist (yahtml-css-collect-classes-file f)))))

2816 (setq e (point))

2817 (goto-char b)

2818 (while (re-search-forward ;ちょといい加減なREGEXP

2819 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2820 e t)

2821 (setq element (YaTeX-match-string 1)

2822 class (YaTeX-match-string 2))

2823 ;;if starts with period (match-string 1 is nil),

2824 ;;this is global class

2825 (setq element (downcase (or element "*")))

2826 (if (setq a (assoc element alist))

2827 (or (assoc class (cdr a))

2828 (setcdr a (cons (list class) (cdr a))))

2829 (setq alist (cons (list element (list class)) alist))))

2830 (goto-char (1- e))

2831 (search-forward "}" nil t)

2832 (setq b (point))))

2833 alist))))

2834

2835 (defun yahtml-css-collect-classes-buffer (&optional initial)

2836 (interactive)

2837 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2838

2839 (defun yahtml-css-collect-classes-file (file &optional initial)

2840 (let*((hilit-auto-highlight nil)

2841 (buf (get-buffer-create

2842 (format " *css-collection*%s" (file-name-nondirectory file))))

2843 (cb (current-buffer)))

2844 (unwind-protect

2845 (progn

2846 (set-buffer buf)

2847 (insert-file-contents file)

2848 (cd (or (file-name-directory file) "."))

2849 (yahtml-css-collect-classes-buffer initial))

2850 (if (eq buf cb)

2851 nil

2852 (kill-buffer buf)

2853 (set-buffer cb)))))

2854

2855 (defun yahtml-css-scan-styles ()

2856 (save-excursion

2857 (goto-char (point-min))

2858 (set (make-local-variable 'yahtml-css-class-alist) nil)

2859 (let (b tag type e href alist)

2860 (while (re-search-forward "<\$style\\|link\$" nil t)

2861 (setq b (match-beginning 0)

2862 tag (YaTeX-match-string 1))

2863 (cond

2864 ((string-match "style" tag)

2865 (goto-char b)

2866 (save-excursion (forward-list 1) (setq e (point)))

2867 (cond

2868 ((search-forward "text/css" e 1) ;css definition starts

2869 (setq alist

2870 (yahtml-css-collect-classes-region

2871 (point) (progn (search-forward "</style>") (point))

2872 alist)))))

2873 ((and (string-match "link" tag)

2874 (stringp (setq type (yahtml-get-attrvalue "type")))

2875 (string-match "text/css" type)

2876 (setq href (yahtml-get-attrvalue "href"))

2877 (file-exists-p (yahtml-url-to-path href)))

2878 (setq alist

2879 (yahtml-css-collect-classes-file

2880 (yahtml-url-to-path href) alist))))

2881 (setq yahtml-css-class-alist alist)))))

2882

2883 (defun yahtml-css-get-element-completion-alist (element)

2884 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

2885 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

2886 (and (or alist global)

2887 (append alist global))))

2888

2889 ;;; ---------- ----------

2890

2891 ;;;

2892 ;;hilit19

2893 ;;;

2894 (defvar yahtml-default-face-table

2895 '(

2896 (form black/ivory white/hex-442233 italic)

2897 ))

2898 (defvar yahtml-hilit-patterns-alist

2899 '(

2900 'case-fold

2901 ;; comments

2902 ("" comment)

2903 ;; include&exec

2904 ("" include)

2905 ;; string

2906 (hilit-string-find ?\\ string)

2907 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

2908 ("</?[uod]l>" 0 decl)

2909 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2910 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

2911 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

2912 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

2913 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2914 ))

2915

2916 (defun yahtml-hilit-region-tag (tag)

2917 "Return list of start/end point of <TAG> form."

2918 (if (re-search-forward tag nil t)

2919 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

2920 (elm (YaTeX-match-string 1)))

2921 (skip-chars-forward "^>")

2922 (prog1

2923 (cons (1+ (point))

2924 (progn (re-search-forward (concat "</" elm ">") nil t)

2925 (match-beginning 0)))

2926 (goto-char e0)))))

2927

2928 (defun yahtml-hilit-region-tag-itself (ptn)

2929 "Return list of start/end point of <tag options...> itself."

2930 (if (re-search-forward ptn nil t)

2931 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

2932 (skip-chars-forward "^<>")

2933 (if (eq (char-after (point)) ?<) nil

2934 (prog1

2935 (cons m0 (min (point-max) (1+ (point))))

2936 (goto-char e0))))))

2937

2938 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2939 (and yahtml-use-hilit19

2940 (or (assq 'yahtml-mode hilit-patterns-alist)

2941 (setq hilit-patterns-alist

2942 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2943 hilit-patterns-alist))))

2944 ;;;

2945 ;; for font-lock

2946 ;;;

2947

2948 ; <<STATIC KEYWORDS BELOW NOT USED>>

2949 ;(defvar yahtml-font-lock-keywords

2950 ; '(

2951 ; ;; comments

2952 ; ("" . font-lock-comment-face)

2953 ; ;; include&exec

2954 ; (""

2955 ; 0 font-lock-include-face keep)

2956 ; ;; string

2957 ; ;(hilit-string-find ?\\ string)

2958 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2959 ; ("</?[uod]l>" 0 font-lock-keyword-face)

2960 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

2961 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

2962 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2963 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

2964 ; )

2965 ; "*Defualt font-lock-keywords for yahtml-mode.")

2966 (defvar yahtml-font-lock-keywords

2967 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

2968 "Default fontifying patterns for yahtml-mode")

2969

2970 (defun yahtml-font-lock-set-default-keywords ()

2971 (put 'yahtml-mode 'font-lock-defaults

2972 '(yahtml-font-lock-keywords nil t)))

2973

2974 (if yahtml-use-font-lock

2975 (progn

2976 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

2977 ;;for those who use both hilit19 and font-lock

2978 (if (eq (car hilit-mode-enable-list) 'not)

2979 (or (member 'yahtml-mode hilit-mode-enable-list)

2980 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

2981 (setq hilit-mode-enable-list

2982 (delq 'yahtml-mode hilit-mode-enable-list))))

2983 (yahtml-font-lock-set-default-keywords)))

2984

2985 (defun yahtml-font-lock-recenter (&optional arg)

2986 (interactive "P")

2987 (font-lock-mode -1) ;is stupid, but sure.

2988 (font-lock-mode 1))

2989

2990 ;; (defun yahtml-fontify-to-tagend (lim)

2991 ;; "*Fontify any tag including < and >.

2992 ;; This is invalid use of font-lock function. Therefore

2993 ;; this fontifying will loose effectiveness soon or later."

2994 ;; (let ((start (match-beginning 0))

2995 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))

2996 ;; (or nil; (font-lock-any-faces-p start end)

2997 ;; (font-lock-fillin-text-property

2998 ;; start end 'face 'font-lock font-lock-keyword-face)))

2999 ;; nil)

3000

3001 (run-hooks 'yahtml-load-hook)

3002 (provide 'yahtml)

3003

3004 ; Local variables:

3005 ; fill-prefix: ";;; "

3006 ; paragraph-start: "^$\\|\\|;;;$"

3007 ; paragraph-separate: "^$\\|\\|;;;$"

3008 ; coding: sjis

3009 ; End: