yatex: f2f0d1eedd39 yahtml.el

yatex

view yahtml.el @ 103:f2f0d1eedd39

Broken parens' balance, fixed.

author	yuuji@gentei.org
date	Tue, 13 Oct 2009 11:53:57 +0900
parents	4be83051f641
children	d461ecc865d4

line source

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

3 ;;; Last modified Tue Oct 13 11:52:40 2009 on firestorm

4 ;;; $Id: yahtml.el,v ce2deaceb818 2009/09/28 02:37:27 yuuji $

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 ;;; AddType "text/html; charset=utf-8" .html (UTF-8の場合)

47 ;;;

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

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

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

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

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

53 ;;;

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

55 ;;;

56 ;;;[Commentary]

57 ;;;

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

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

60 ;;;

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

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

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

64 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

89 ;;; change the reference link with completion.

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

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

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

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

94 ;;; is "netscape")

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

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

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

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

99 ;;; in the region.

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

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

102 ;;; URLencoded string in the region.

103 ;;;

104 ;;;[キーの説明]

105 ;;;

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

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

108 ;;;

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

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

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

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

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

114 ;;; できます。

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

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

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

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

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

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

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

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

123 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

135 ;;; す。

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

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

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

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

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

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

142 ;;; きます。

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

144 ;;; す。

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

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

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

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

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

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

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

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

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

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

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

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

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

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

159 ;;;

160 ;;; [謝辞]

161 ;;;

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

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

164 ;;;

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

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

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

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

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

170 ;;;

171

172

173 (require 'yatexlib)

174 ;;; --- customizable variable starts here ---

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

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

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

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

179 (defvar yahtml-kanji-code 2

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

181 ;;(defvar yahtml-coding-system

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

183 ;; "Kanji coding system")

184 (and (featurep 'mule)

185 (integerp yahtml-kanji-code)

186 (setq yahtml-kanji-code

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

188

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

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

191

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

193 (defvar yahtml-path-url-alist nil

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

195 Ex.

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

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

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

199 "*Directory index file name;

200 Consult your site's WWW administrator.")

201

202 (defvar yahtml-environment-indent 1

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

204

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

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

207 "*Program name to lint HTML file")

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

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

210

211 (defvar yahtml-always-/p t

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

213 (defvar yahtml-always-/li nil

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

215 (defvar yahtml-always-/dt nil

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

217 (defvar yahtml-always-/dd nil

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

219

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

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

222

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

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

225

226 (defvar yahtml-prefer-upcases nil

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

228

229 (defvar yahtml-prefer-upcase-attributes nil

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

231

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

233

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

235 "*Server access file name for apache")

236

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

238

239 (defvar yahtml-image-inspection-bytes 50000

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

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

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

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

244 %f: filename")

245

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

247 (defvar yahtml-error-line-regexp

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

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

250

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

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

253 (defvar yahtml-escape-chars 'ask

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

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

256 at each reserved chars.")

257

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

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

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

261

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

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

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

265

266 (defvar yahtml-mode-abbrev-table nil

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

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

269

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

271 "*Boundary regexp for indentation calculation.")

272

273 (defvar yahtml-html4-strict t

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

275 Completing read for obsoleted attributes disabled.")

276

277 ;;; --- customizable variable ends here ---

278 (defvar yahtml-prefix-map nil)

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

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

281 (defvar yahtml-shell-command-option

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

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

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

285

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

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

288 (YaTeX-define-key

289 key

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

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

292 map))

293

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

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

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

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

298

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

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

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

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

303 (if YaTeX-inhibit-prefix-letter nil

304 (yahtml-define-begend-region-key

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

306

307 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

320 (let ((map yahtml-prefix-map))

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

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

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

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

325 (and YaTeX-emacs-19 window-system

326 (progn

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

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

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

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

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

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

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

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

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

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

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

338 (if YaTeX-no-begend-shortcut

339 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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 (substitute-all-key-definition

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

378 (substitute-all-key-definition

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

380

381 (if yahtml-lint-buffer-map nil

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

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

384

385

386 (defvar yahtml-paragraph-start

387 (concat

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

389 "*Regexp of html paragraph separater")

390 (defvar yahtml-paragraph-separate

391 (concat

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

393 "*Regexp of html paragraph separater")

394 (defvar yahtml-syntax-table nil

395 "*Syntax table for yahtml-mode")

396

397 (if yahtml-syntax-table nil

398 (setq yahtml-syntax-table

399 (make-syntax-table (standard-syntax-table)))

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

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

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

403

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

405 "Regexp of constituent of html commands.")

406

407 ;;; Completion tables for `form'

408 (defvar yahtml-form-table

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

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

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

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

413

414 (defvar yahtml-env-table

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

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

417 ("OrderedList" . "ol")

418 ("UnorderedList" . "ul")

419 ("DefinitionList" . "dl")

420 ("Preformatted" . "pre")

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

422 ("address")

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

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

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

426 ))

427

428 (if yahtml-html4-strict

429 (setq yahtml-env-table

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

431

432 ;(defvar yahtml-itemizing-regexp

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

434 ; "Regexp of itemizing forms")

435

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

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

438

439 ;;; Completion tables for typeface designator

440 (and yahtml-always-/p

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

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

443 (and yahtml-always-/li

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

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

446 (and yahtml-always-/dt

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

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

449 (and yahtml-always-/dd

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

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

452

453 (defvar yahtml-typeface-table

454 (append

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

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

457 ("sup") ("sub") ("span") ("abbr"))

458 (if (not yahtml-html4-strict)

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

460 yahtml-env-table)

461 "Default completion table of typeface designator")

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

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

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

465

466 (defvar yahtml-single-cmd-table

467 '(("hr") ("br") ("option")

468 ("HorizontalRule" . "hr")

469 ("BreakLine" . "br")

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

471 ("!--#exec")

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

473 ("!--#include")

474 ;; ("Item" . "li")

475 ;; ("DefineTerm" . "dt")

476 ;; ("Description" . "dd")

477 ;; ("dd") ("dt") ("li")

478 )

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

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

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

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

483

484 (defvar yahtml-current-completion-type nil

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

486

487 (defvar yahtml-struct-name-regexp

488 (concat

489 "\\<\\("

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

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

492 "\\)\\b")

493 "Regexp of structure beginning.")

494

495 (defvar yahtml-closable-regexp

496 (concat

497 "\\<\\("

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

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

500 "\\)\\b")

501 "Regexp of any closable elemnts.")

502

503 (defvar yahtml-indent-listing-constant t

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

505 T for static indentation depth")

506

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

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

509

510

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

512 (cond

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

514 buffer-file-name)

515 (let ((dir default-directory)

516 charset af ext (ldir "")

517 line

518 (case-fold-search t)

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

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

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

522 (while (and dir

523 (not (string= dir ldir))

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

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

526 (if (file-exists-p af)

527 (save-excursion

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

529 (save-excursion

530 (goto-char (point-min))

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

532 (setq line (buffer-substring

533 (point-beginning-of-line)

534 (point-end-of-line))

535 dir nil)))

536 (kill-buffer (current-buffer))))

537 (if dir

538 (setq ldir dir

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

540 dir (file-name-directory dir))))

541 line))

542 (t nil)))

543

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

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

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

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

548 (case-fold-search t)

549 line

550 charset)

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

552 (progn

553 (string-match ptn line)

554 (setq charset

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

556 (cond

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

558 (setq charset 2))

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

560 (setq charset 3))

561 ((string-match "shift_jis" charset)

562 (setq charset 1))

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

564 (setq charset 4))

565 (t (setq charset nil)))

566 (setq dir "")))

567 (if (featurep 'mule)

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

569 charset))

570

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

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

573 x index-list)

574 ;;s/\\s *$//;

575 (if line

576 (progn

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

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

579 (while (string< "" line)

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

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

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

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

584 line "")))

585 (or (nreverse index-list)

586 (if (listp yahtml-directory-index)

587 yahtml-directory-index

588 (list yahtml-directory-index)))))))

589

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

591 (defun yahtml-mode ()

592 (interactive)

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

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

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

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

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

598 (cond

599 ((null coding) nil)

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

601 (setq buffer-file-coding-system

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

603 (save-excursion

604 (goto-char (point-min))

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

606 coding)))

607 ((featurep 'mule)

608 (set-file-coding-system coding))

609 ((boundp 'NEMACS)

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

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

612 (setq major-mode 'yahtml-mode

613 mode-name "yahtml"

614 YaTeX-current-file-name (file-name-nondirectory

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

616 local-abbrev-table yahtml-mode-abbrev-table)

617 (mapcar

618 (function (lambda (x)

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

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

621 (boundp (cdr x)))

622 (symbol-value (cdr x))

623 (cdr x)))))

624 '((YaTeX-ec . "")

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

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

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

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

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

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

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

632 (paragraph-start . yahtml-paragraph-start)

633 (paragraph-separate . yahtml-paragraph-separate)

634 (comment-start . "")

635 (comment-start-skip . comment-start)

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

637

638 (if yahtml-use-font-lock

639 (progn

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

641 (or (featurep 'xemacs)

642 (progn

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

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

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

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

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

648 (font-lock-fontify-buffer)))))

649 (set-syntax-table yahtml-syntax-table)

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

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

652 (yahtml-css-scan-styles)

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

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

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

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

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

658

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

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

661 font-lock-defaults)

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

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

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

665

666 (defun yahtml-version ()

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

668 (interactive)

669 (message

670 (concat "Yet Another HTML-mode "

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

672 " Revision "

673 yahtml-revision-number)))

674

675 (defun yahtml-quit ()

676 (interactive)

677 (and yahtml-mode-old-mode

678 (fboundp yahtml-mode-old-mode)

679 (funcall yahtml-mode-old-mode)))

680

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

682 (cond

683 ((featurep 'xemacs)

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

685 (set keymap nil)

686 (mapcar

687 (function

688 (lambda (bind)

689 (setq bind (cdr bind))

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

691 (setcar (cdr bind) 'progn))

692 (if (stringp (car (cdr bind)))

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

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

695 (symbol-value keymap))))))

696 bindlist)

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

698 (t

699 (mapcar

700 (function

701 (lambda (bind)

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

703 bindlist))))

704

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

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

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

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

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

710

711 ;;; Variables for mosaic url history

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

713 (defvar yahtml-urls-private nil)

714 (defvar yahtml-urls-local nil)

715

716 (cond

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

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

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

720 (YaTeX-define-menu

721 'yahtml-menu-map-sectioning

722 (nreverse

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

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

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

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

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

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

729 )))

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

731 (YaTeX-define-menu

732 'yahtml-menu-map-logical

733 (nreverse

734 '((em "Embolden" .

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

736 (dfn "Define a word" .

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

738 (cite "Citation" .

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

740 (code "Code" .

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

742 (kbd "Keyboard" .

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

744 (samp "Sample display" .

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

746 (strong "Strong" .

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

748 (VAR "Variable notation" .

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

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

751 (YaTeX-define-menu

752 'yahtml-menu-map-typeface

753 (nreverse

754 '((b "Bold" .

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

756 (i "Italic" .

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

758 (tt "Typewriter" .

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

760 (u "Underlined" .

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

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

763 (YaTeX-define-menu

764 'yahtml-menu-map-listing

765 (nreverse

766 '((ul "Unordered" .

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

768 (ol "Ordered" .

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

770 (dl "Definition" .

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

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

773 (YaTeX-define-menu

774 'yahtml-menu-map-item

775 (nreverse

776 '((li "Simple item" .

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

778 (dt "Define term" .

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

780 (dd "Description of term" .

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

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

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

784 (YaTeX-define-menu

785 'yahtml-menu-map

786 (nreverse

787 (list

788 (cons (list 'sect "Sectioning")

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

790 (cons (list 'list "Listing")

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

792 (cons (list 'item "Item")

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

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

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

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

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

798 (if (featurep 'xemacs)

799 (add-hook 'yahtml-mode-hook

800 '(lambda ()

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

802 (progn

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

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

805

806 ;;; ----------- Completion ----------

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

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

809 "Insert <cmd> ... </cmd>."

810 (interactive "P")

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

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

813 (cmd

814 (or env

815 (YaTeX-cplread-with-learning

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

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

818 (bolp (save-excursion

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

820 (cc (current-column)))

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

822 (setq yahtml-last-begend

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

824 yahtml-last-begend))

825 (setq cmd yahtml-last-begend)

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

827 (if region

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

829 ;; to enable continuous regioning by another environment

830 (let ((beg (region-beginning))

831 (end (region-end))

832 (addin (yahtml-addin cmd)))

833 (save-excursion

834 (goto-char end)

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

836 (goto-char beg)

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

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

839 (save-excursion

840 (insert "\n")

841 (indent-to-column cc)

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

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

844 (newline)

845 (yahtml-intelligent-newline nil))

846 (yahtml-indent-line))))

847

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

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

850 (interactive)

851 (yahtml-insert-begend t))

852

853

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

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

856 (interactive)

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

858 (or form

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

860 (setq form

861 (YaTeX-cplread-with-learning

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

863 'yahtml-form-table 'yahtml-user-form-table

864 'yahtml-tmp-form-table))))

865 (let ((p (point)) q)

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

867 (setq yahtml-last-form form)

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

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

870 ;;(indent-relative-maybe)

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

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

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

874

875 (defun yahtml-read-css (alist)

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

877 (minibuffer-completion-table alist))

878 (read-from-minibuffer

879 (substitute-command-keys

880 (if YaTeX-japan

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

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

883 nil YaTeX-minibuffer-completion-map nil)))

884

885 ;;; ---------- Add-in ----------

886 (defun yahtml-addin (form)

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

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

889 (concat

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

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

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

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

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

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

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

897 (string< "" s))

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

899 ""))))

900

901 (defvar yahtml-completing-buffer nil)

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

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

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

905 (let (list end)

906 (save-excursion

907 (set-buffer yahtml-completing-buffer)

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

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

910 (save-excursion

911 (goto-char (point-min))

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

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

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

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

916 (setq end (match-end 0))

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

918 (yahtml-on-assignment-p)

919 (progn

920 (goto-char end)

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

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

923 (setq list (cons

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

925 list))))

926 list))))

927

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

929 (if yahtml-url-completion-map nil

930 (setq yahtml-url-completion-map

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

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

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

934

935 (defun yahtml-complete-url ()

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

937 (interactive)

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

939 (lim (YaTeX-minibuffer-begin))

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

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

942 (cond

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

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

945 listfunc (list 'lambda nil

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

947 beg min))

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

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

950 (progn

951 (setq path (substring initial 0 beg))

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

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

954 (setq initial (substring initial beg))

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

956 cmpl (try-completion initial labels)

957 listfunc (list 'lambda ()

958 (list 'all-completions

959 initial (list 'quote labels)))

960 beg (+ min beg)))

961 (t

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

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

964 initial))

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

966 file (file-name-nondirectory path)

967 initial file

968 cmpl (file-name-completion file dir)

969 listfunc (list 'lambda nil

970 (list 'file-name-all-completions

971 file dir))

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

973 (cond

974 ((stringp cmpl)

975 (if (string= initial cmpl)

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

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

978 (princ

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

980 (delete-region (point) beg)

981 (insert cmpl)))

982 ((null cmpl)

983 (ding))

984 ((eq t cmpl)

985 (save-excursion

986 (unwind-protect

987 (progn

988 (goto-char p)

989 (insert " [Sole completion]"))

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

991

992 ;

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

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

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

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

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

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

999 ;

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

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

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

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

1004 (defvar yahtml-unsafe-chars-regexp

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

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

1007 ;

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

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

1010 ;

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

1012 ; "$" | ","

1013 (defvar yahtml-unreserved-chars-regexp

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

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

1016 Not used yet.")

1017

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

1019 "Translate reserved chars to URL encoded string."

1020 (let ((p 0) (target "")

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

1022 (cond

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

1024 (t

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

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

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

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

1029 (setq target (concat target

1030 (substring str 0 p)

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

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

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

1034 (concat target str)))))

1035

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

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

1038 (interactive "r")

1039 (save-excursion

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

1041 (goto-char beg)

1042 (while (and (< (point) e)

1043 (re-search-forward

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

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

1046 (sit-for 0)

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

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

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

1050 ; (unwind-protect

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

1052 ; (save-excursion

1053 ; (backward-char 1)

1054 ; (delete-backward-char 4))

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

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

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

1058 (progn

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

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

1061 (set-marker e nil))))

1062 ;; ab%defgls/.|

1063

1064 (defun yahtml:a ()

1065 "Add-in function for <a>"

1066 (let ((href ""))

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

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

1069 href (yahtml-escape-chars-string

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

1071 (prog1

1072 (concat (yahtml-make-optional-argument

1073 "href" href)

1074 (yahtml-make-optional-argument

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

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

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

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

1079 (YaTeX-update-table

1080 (list href)

1081 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1082

1083 (defvar yahtml-parameters-completion-alist

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

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

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

1087 ("src" . file) ("file" . file)

1088 ("background" . file)

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

1090 ("method" ("POST") ("GET"))

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

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

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

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

1095 ("http-equiv" ("Refresh"))))

1096

1097 (defvar yahtml-link-types-alist

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

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

1100 ("subsection") ("appendix") ("help") ("bookmark")))

1101

1102 (defvar yahtml-content-types-alist

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

1104 ("text/sgml") ("text/xml")

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

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

1107 ("application/java")

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

1109 "Alist of content-types")

1110

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

1112 (let* ((alist

1113 (cdr-safe (assoc (downcase par)

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

1115 (prompt (concat par ": "))

1116 v)

1117 (cond

1118 ((eq alist 'file)

1119 (let ((insert-default-directory))

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

1121 ((and alist (symbolp alist))

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

1123 (alist

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

1125 (t

1126 (read-string prompt default)))))

1127

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

1129 "Make optional argument string."

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

1131 ""

1132 (concat " "

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

1134 "=\"" arg "\"")))

1135

1136 (defun yahtml:html ()

1137 "Add-in for <html>"

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

1139 (yahtml-make-optional-argument

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

1141

1142 (defun yahtml:head ()

1143 "Add-in for <head>"

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

1145 "")

1146

1147 (defun yahtml:body ()

1148 "Add-in function for <body>"

1149 (cond

1150 (yahtml-html4-strict nil)

1151 (t

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

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

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

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

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

1157 (concat

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

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

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

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

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

1163

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

1165 "Make CSS property definitions in style attribute."

1166 (mapconcat

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

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

1169 (delq nil proplist)

1170 " "))

1171

1172 (defun yahtml:img ()

1173 "Add-in function for <img>"

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

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

1176 alt

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

1178 (l yahtml-prefer-upcase-attributes)

1179 info width height bytes comments)

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

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

1182 (car info)

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

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

1185 bytes (car (cdr (cdr info)))

1186 comments (nth 4 info)))

1187 (if info

1188 (setq alt

1189 (YaTeX-replace-formats

1190 yahtml:img-default-alt-format

1191 (list (cons "x" width)

1192 (cons "y" height)

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

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

1195 (cons "c" (car comments))))))

1196

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

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

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

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

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

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

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

1204 (if yahtml-html4-strict

1205 (yahtml-make-optional-argument

1206 "style"

1207 (if (or brd alg)

1208 (yahtml-make-style-parameter

1209 (list

1210 (if (string< "" alg)

1211 (cons "align" alg))

1212 (if (string< "" brd)

1213 (cons "border"

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

1215 (concat

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

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

1218

1219 (defun yahtml-file-truename (file)

1220 (cond

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

1222 (t (let ((new file))

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

1224 (not (equal new file)))

1225 (setq file new))

1226 file))))

1227

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

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

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

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

1232 (let ((mlt 1)

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

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

1235 (value 0))

1236 (while (> length 0)

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

1238 pos (+ pos direc)

1239 mlt (* mlt 256)

1240 length (1- length)))

1241 value))

1242

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

1244 "Return the information on the image file FILE.

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

1246 (save-excursion

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

1248 width height bytes depth comment

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

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

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

1252 (seekpoint 1)

1253 c1 c2 c3 c4 beg end

1254 (case-fold-search nil))

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

1256 (set-buffer tmpbuf)

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

1258 (erase-buffer)

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

1260 (unwind-protect

1261 (progn

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

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

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

1265 (YaTeX-insert-file-contents

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

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

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

1269 c2 (char-after 2)

1270 c3 (char-after 3)

1271 c4 (char-after 4))

1272 (cond

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

1274 ;;JPEG images need JPEG markers inspection

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

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

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

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

1279 (catch 'exit

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

1281 (cond

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

1283 ;maybe corrupted, exit from loop

1284 (throw 'exit t))

1285 ((memq

1286 (char-after (1+ seekpoint))

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

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

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

1290 ;;found!

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

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

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

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

1295 ;; JPEG comment area

1296 (setq beg (+ seekpoint 2 2)

1297 end (+ seekpoint

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

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

1300 (t ;other markers

1301 nil)) ;just skip it

1302 (setq seekpoint (+ seekpoint 2)

1303 seekpoint (+ seekpoint

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

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

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

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

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

1309 height (yahtml-hex-value 20 4)

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

1311 ((looking-at "GIF8")

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

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

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

1315 ((looking-at "BM")

1316 ;;# OS/2, Windoze BMP files

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

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

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

1320 (cond

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

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

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

1324 (t

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

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

1327 (message "")

1328 (kill-buffer tmpbuf))

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

1330

1331 (defun yahtml:form ()

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

1333 (concat

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

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

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

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

1338

1339 (defun yahtml:select ()

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

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

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

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

1344

1345 (defun yahtml:ol ()

1346 "Add-in function for <ol>"

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

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

1349 (type (completing-read

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

1351 (concat

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

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

1354 (defun yahtml:ul ()

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

1356 (defun yahtml:dl ()

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

1358 (defun yahtml:dt ()

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

1360

1361 (defun yahtml:p ()

1362 (if yahtml-html4-strict nil

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

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

1365

1366 (defvar yahtml-input-types

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

1368 ("reset") ("image") ("hidden") ("file")))

1369

1370 (defun yahtml:input ()

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

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

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

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

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

1376 yahtml-input-types nil t)

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

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

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

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

1381 (concat

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

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

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

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

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

1387

1388 (defun yahtml:textarea ()

1389 "Add-in function for `textarea'"

1390 (interactive)

1391 (let (name rows cols)

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

1393 cols (read-string "Columns: ")

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

1395 (concat

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

1397 "\"" name "\"")

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

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

1400

1401 (defun yahtml:table ()

1402 "Add-in function for `table'"

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

1404 (a (yahtml-read-parameter

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

1406 (if yahtml-html4-strict

1407 (yahtml-make-optional-argument

1408 "style"

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

1410 (yahtml-make-style-parameter

1411 (append

1412 (if (string< "" b)

1413 (list

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

1415 (cons "border-collapse" "collapse")))

1416 (if (string< "" a)

1417 (cond

1418 ((string-match "right" a)

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

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

1421 ((string-match "center" a)

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

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

1424 (concat

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

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

1427

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

1429 (defun yahtml:caption ()

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

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

1432 (if yahtml-html4-strict

1433 (yahtml-make-optional-argument

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

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

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

1437

1438 (defun yahtml:font ()

1439 "Add-in function for `font'"

1440 (concat

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

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

1443

1444 (defun yahtml:style ()

1445 "Add-in function for `style'"

1446 (yahtml-make-optional-argument

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

1448

1449 (defun yahtml:script ()

1450 "Add-in function for `script'"

1451 (concat

1452 (yahtml-make-optional-argument

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

1454 (yahtml-make-optional-argument

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

1456

1457 (defun yahtml:tr ()

1458 "Add-in function for `tr'"

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

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

1461 "")

1462

1463 (defun yahtml:link ()

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

1465 (let (rel rev type href)

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

1467 (cond

1468 ((equal rel "")

1469 (concat (yahtml-make-optional-argument

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

1471 (yahtml-make-optional-argument

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

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

1474 )))

1475 ((string-match "stylesheet" rel)

1476 (concat

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

1478 (yahtml-make-optional-argument

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

1480 (progn

1481 (setq href

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

1483 (if (string< "" href)

1484 (progn

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

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

1487 (setq yahtml-css-class-alist

1488 (yahtml-css-collect-classes-file

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

1490 (message "")

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

1492 (t

1493 (concat

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

1495 (yahtml-make-optional-argument

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

1497 (yahtml-make-optional-argument

1498 "href"

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

1500

1501 (defvar yahtml:meta-names

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

1503

1504 (defun yahtml:meta ()

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

1506 "name"

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

1508 http-equiv content)

1509 (if (string= "" name)

1510 (if (string-match

1511 "Content-type"

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

1513 "http-equiv"

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

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

1516 "See docs/qanda")

1517 (concat http-equiv

1518 (yahtml-make-optional-argument

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

1520 (concat

1521 name

1522 (yahtml-make-optional-argument

1523 "content"

1524 (cond

1525 ((string-match "date" name)

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

1527 ((string-match "author" name)

1528 (read-string "Author: "

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

1530 (user-full-name)

1531 (user-login-name))))

1532 ((string-match "GENERATOR" name)

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

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

1535 (message "Thank you!"))

1536 content)

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

1538

1539 (defun yahtml:br ()

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

1541

1542 (defun yahtml:object ()

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

1544 data classid)

1545 (cond

1546 ((string-match "java" codetype)

1547 (let ((completion-ignored-extensions

1548 ;;any extensions except ".class"

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

1550 (setq classid (concat "java:"

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

1552 (concat

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

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

1555 (yahtml-make-optional-argument

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

1557 (yahtml-make-optional-argument

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

1559 (yahtml-make-optional-argument

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

1561 (t

1562 ""))))

1563

1564 (defun yahtml:abbr ()

1565 "Add-in function for abbr."

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

1567

1568 ;;; ---------- Simple tag ----------

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

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

1571 (interactive "P")

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

1573 (or tag

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

1575 (setq tag

1576 (YaTeX-cplread-with-learning

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

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

1579 'yahtml-typeface-table 'yahtml-user-typeface-table

1580 'yahtml-tmp-typeface-table))))

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

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

1583 (setq yahtml-last-typeface-cmd tag

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

1585 (if region-mode

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

1587 (save-excursion

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

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

1590 (exchange-point-and-mark)

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

1592 (message "No mark set now"))

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

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

1595

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

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

1598 (interactive)

1599 (yahtml-insert-tag t tag))

1600

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

1602 (defun yahtml-insert-single (cmd)

1603 "Insert <CMD>."

1604 (interactive

1605 (list

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

1607 (YaTeX-cplread-with-learning

1608 (format "Command%s: "

1609 (if yahtml-last-single-cmd

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

1611 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1614 (setq yahtml-last-single-cmd

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

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

1617 yahtml-last-single-cmd))

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

1619 cmd

1620 (yahtml-addin cmd)

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

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

1623 " /" "")))

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

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

1626

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

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

1629 (interactive "P")

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

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

1632

1633 (defun yahtml-insert-amps (arg)

1634 "Insert char-entity references via ampersand"

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

1636 (interactive "P")

1637 (let*((mess "") c

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

1639 yahtml-entity-reference-chars-alist))

1640 (l list))

1641 (while l

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

1643 l (cdr l)))

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

1645 (setq c (read-char))

1646 (cond

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

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

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

1650 (insert "&;")

1651 (forward-char -1))

1652 ((equal c ? )

1653 (insert ?&))

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

1655

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

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

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

1659

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

1661 (format "cmd=\"%s\"--" (yahtml-read-parameter "cmd" "" '(("cmd" . file)))))

1662

1663 ;;; ---------- Jump ----------

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

1665 "Check if point is on href clause."

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

1667 (save-excursion

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

1669 (save-excursion

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

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

1672 (setq e (point)))

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

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

1675 (search-forward "href" e t)

1676 (search-forward "=" e t)

1677 (progn

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

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

1680 (< p (match-end 0))

1681 (YaTeX-match-string 1)))))

1682

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

1684 (cond

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

1686 (set-process-buffer proc nil))

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

1688 (let ((cb (current-buffer)))

1689 (set-buffer (process-buffer proc))

1690 (goto-char (point-min))

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

1692 (progn

1693 (message "Starting netscape...")

1694 (start-process

1695 "browser" (process-buffer proc)

1696 shell-file-name yahtml-shell-command-option

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

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

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

1700 (set-buffer cb)))))

1701

1702 (defvar yahtml-browser-process nil)

1703

1704 (defun yahtml-browse-html (href)

1705 "Call WWW Browser to see HREF."

1706 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1707 (cond

1708 ((string-match "^start\\>" yahtml-www-browser)

1709 (if (get-buffer pb)

1710 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1711 (put 'yahtml-netscape-sentinel 'url href)

1712 (set-process-sentinel

1713 (setq yahtml-browser-process

1714 (start-process

1715 "browser" pb shell-file-name yahtml-shell-command-option

1716 (format "%s \"%s\"" yahtml-www-browser href)))

1717 'yahtml-netscape-sentinel))

1718 ((and (string-match

1719 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

1720 (not (eq system-type 'windows-nt)))

1721 (if (get-buffer pb)

1722 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1723 (put 'yahtml-netscape-sentinel 'url href)

1724 (set-process-sentinel

1725 (setq yahtml-browser-process

1726 (start-process

1727 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1728 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1729 'yahtml-netscape-sentinel))

1730 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1731 (w3-fetch href))

1732 ((stringp yahtml-www-browser)

1733 (if (and yahtml-browser-process

1734 (eq (process-status yahtml-browser-process) 'run))

1735 (message "%s is already running" yahtml-www-browser)

1736 (setq yahtml-browser-process

1737 (start-process

1738 "browser" "* WWW Browser *"

1739 shell-file-name yahtml-shell-command-option

1740 (format "%s \"%s\"" yahtml-www-browser href)))))

1741 (t

1742 (message "Sorry, jump across http is not supported.")))))

1743

1744 (defun yahtml-goto-corresponding-href (&optional other)

1745 "Go to corresponding name."

1746 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1747 (if href

1748 (cond

1749 ((string-match "^\$ht\\|f\$tps?:" href)

1750 (yahtml-browse-html href))

1751 (t (setq file (substring href 0 (string-match "#" href)))

1752 (if (string-match "#" href)

1753 (setq name (substring href (1+ (string-match "#" href)))))

1754 (if (string< "" file)

1755 (progn

1756 (if (string-match "/$" file)

1757 (or (catch 'dirindex

1758 (mapcar

1759 (function

1760 (lambda (f)

1761 (if (file-exists-p (concat file f))

1762 (throw 'dirindex

1763 (setq file (concat file f))))))

1764 (yahtml-get-directory-index))

1765 nil)

1766 (setq file (concat file yahtml-directory-index))))

1767 (if (string-match "^/" file)

1768 (setq file (yahtml-url-to-path file)))

1769 (if other (YaTeX-switch-to-buffer-other-window file)

1770 (YaTeX-switch-to-buffer file))

1771 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1772 (if name

1773 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1774 t)))))

1775

1776 (defun yahtml-jump-to-name (name)

1777 "Jump to html's named tag."

1778 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1779 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1780 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1781 (message "Named tag `%s' not found" (substring href 1))))

1782

1783 (defun yahtml-on-begend-p (&optional p)

1784 "Check if point is on begend clause."

1785 (let ((p (or p (point))) cmd (case-fold-search t))

1786 (save-excursion

1787 (goto-char p)

1788 (if (equal (char-after (point)) ?<) (forward-char 1))

1789 (if (and (re-search-backward "<" nil t)

1790 (looking-at

1791 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1792 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1793 (condition-case nil

1794 (forward-list 1)

1795 (error nil))

1796 (< p (point)))

1797 (YaTeX-match-string 1)))))

1798

1799 (defun yahtml-goto-corresponding-begend (&optional noerr)

1800 "Go to corresponding opening/closing tag.

1801 Optional argument NOERR causes no error for unballanced tag."

1802 (let ((cmd (yahtml-on-begend-p)) m0

1803 (p (point)) (case-fold-search t) func str (nest 0))

1804 (cond

1805 (cmd

1806 (setq m0 (match-beginning 0))

1807 (if (= (aref cmd 0) ?/) ;on </cmd> line

1808 (setq cmd (substring cmd 1)

1809 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1810 func 're-search-backward)

1811 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1812 func 're-search-forward))

1813 (while (and (>= nest 0) (funcall func str nil t))

1814 (if (equal m0 (match-beginning 0))

1815 nil

1816 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1817 (if (< nest 0)

1818 (goto-char (match-beginning 0))

1819 (funcall

1820 (if noerr 'message 'error)

1821 "Corresponding tag of `%s' not found." cmd)

1822 (goto-char p)

1823 nil))

1824 (t nil))))

1825

1826 (defun yahtml-current-tag ()

1827 "Return the current tag name including #exec and #include."

1828 (save-excursion

1829 (let ((p (point)) b tag)

1830 (or (bobp)

1831 (looking-at "<")

1832 (progn (skip-chars-backward "^<") (forward-char -1)))

1833 (setq b (point))

1834 (skip-chars-forward "<")

1835 (setq tag (YaTeX-buffer-substring

1836 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1837 (goto-char b)

1838 (forward-list 1)

1839 (and (< p (point)) tag))))

1840

1841 (defun yahtml-get-attrvalue (attr)

1842 "Extract current tag's attribute value from buffer."

1843 (let (e (case-fold-search t))

1844 (save-excursion

1845 (or (looking-at "<")

1846 (progn (skip-chars-backward "^<") (backward-char 1)))

1847 (setq e (save-excursion (forward-list 1) (point)))

1848 (if (and

1849 (re-search-forward (concat "\\b" attr "\\b") e t)

1850 (progn (skip-chars-forward " \t\n=")

1851 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1852 (YaTeX-match-string 1)))))

1853

1854 (defun yahtml-goto-corresponding-img ()

1855 "View image on point"

1856 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1857 (if (and tag

1858 (string-match "img" tag)

1859 (setq image (yahtml-get-attrvalue "src")))

1860 (progn

1861 (message "Invoking %s %s..." yahtml-image-viewer image)

1862 (start-process

1863 "Viewer" " * Image Viewer *"

1864 shell-file-name yahtml-shell-command-option ;"-c"

1865 (concat yahtml-image-viewer " " image))

1866 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1867

1868 (defun yahtml-goto-corresponding-source (&optional other)

1869 "Goto applet's or script's source."

1870 (let ((env (yahtml-current-tag)) s (p (point)))

1871 (cond

1872 ((string-match "applet" env)

1873 (if (setq s (yahtml-get-attrvalue "code"))

1874 (progn

1875 (setq s (YaTeX-match-string 1)

1876 s (concat

1877 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1878 ".java"))

1879 (if other (YaTeX-switch-to-buffer-other-window s)

1880 (YaTeX-switch-to-buffer s))

1881 s) ;return source file name

1882 (message "No applet source specified")

1883 (sit-for 1)

1884 nil))

1885 ((string-match "script" env)

1886 (if (setq s (yahtml-get-attrvalue "src"))

1887 (progn

1888 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1889 'YaTeX-switch-to-buffer)

1890 (yahtml-url-to-path s))

1891 s)))

1892 ((string-match "!--#include" env)

1893 (cond

1894 ((setq s (yahtml-get-attrvalue "file")) ;

1895 (if other (YaTeX-switch-to-buffer-other-window s)

1896 (YaTeX-switch-to-buffer s))

1897 s)

1898 ((setq s (yahtml-get-attrvalue "virtual"));

1899 (setq s (yahtml-url-to-path s))

1900 (if other (YaTeX-switch-to-buffer-other-window s)

1901 (YaTeX-switch-to-buffer s))

1902 s)))

1903 ((and (string-match "!--#exec" env)

1904 (setq s (yahtml-get-attrvalue "cmd")))

1905 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1906 (let ((b " *yahtmltmp*")) ;peek a little

1907 (unwind-protect

1908 (progn

1909 (set-buffer (get-buffer-create b))

1910 (YaTeX-insert-file-contents s nil 0 100)

1911 (if (looking-at "#!")

1912 (if other (YaTeX-switch-to-buffer-other-window s)

1913 (YaTeX-switch-to-buffer s))))

1914 (kill-buffer (get-buffer b)))

1915 (get-file-buffer s))))))

1916

1917 (defun yahtml-goto-corresponding-* (&optional other)

1918 "Go to corresponding object."

1919 (interactive "P")

1920 (cond

1921 ((yahtml-goto-corresponding-href other))

1922 ((yahtml-goto-corresponding-img))

1923 ((yahtml-goto-corresponding-source other))

1924 ((yahtml-goto-corresponding-begend))

1925 (t (message "I don't know where to go."))))

1926

1927 (defun yahtml-goto-corresponding-*-other-window ()

1928 "Go to corresponding object."

1929 (interactive)

1930 (yahtml-goto-corresponding-* t))

1931

1932 (defun yahtml-visit-main ()

1933 "Go to parent file from where you visit current file."

1934 (interactive)

1935 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1936

1937 ;;; ---------- killing ----------

1938 (defun yahtml-kill-begend (&optional whole)

1939 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1940 (if tag

1941 (save-excursion

1942 (or (looking-at "<")

1943 (progn (skip-chars-backward "^<") (forward-char -1)))

1944 (setq p (point))

1945 (yahtml-goto-corresponding-begend)

1946 (or (looking-at "<")

1947 (progn (skip-chars-backward "^<") (forward-char -1)))

1948 (if (< (point) p) ;if on the opening tag

1949 (progn (setq q p p (point))

1950 (goto-char q))

1951 (setq q (point))) ;now q has end-line's (point)

1952 (if (not whole)

1953 (kill-region

1954 (progn (skip-chars-backward " \t")

1955 (if (setq bbolp (bolp)) (point) q))

1956 (progn (forward-list 1)

1957 (setq r (point))

1958 (skip-chars-forward " \t")

1959 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1960 (goto-char p)

1961 (skip-chars-backward " \t")

1962 (if (not whole)

1963 (progn

1964 (kill-append

1965 (buffer-substring

1966 (setq p (if (setq bbolp (bolp)) (point) p))

1967 (setq q (progn

1968 (forward-list 1)

1969 (setq r (point))

1970 (skip-chars-forward " \t")

1971 (if (and bbolp (eolp) (not (eobp)))

1972 (1+ (point))

1973 r))))

1974 t)

1975 (delete-region p q))

1976 (kill-region

1977 (if (bolp) (point) p)

1978 (progn (goto-char q)

1979 (forward-list 1)

1980 (setq r (point))

1981 (skip-chars-forward " \t")

1982 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1983 tag))))

1984

1985 (defun yahtml-kill-* (whole)

1986 "Kill current position's HTML tag (set)."

1987 (interactive "P")

1988 (cond

1989 ((yahtml-kill-begend whole))))

1990

1991

1992 ;;; ---------- changing ----------

1993 (defun yahtml-on-assignment-p ()

1994 "Return if current point is on parameter assignment.

1995 If so, return parameter name, otherwise nil.

1996 This function should be able to treat white spaces in value, but not yet."

1997 (let ((p (point)))

1998 (save-excursion

1999 (put 'yahtml-on-assignment-p 'region nil)

2000 (skip-chars-backward "^ \t\n")

2001 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2002 (< p (match-end 0))

2003 (>= p (1- (match-beginning 2)))

2004 (put 'yahtml-on-assignment-p 'region

2005 (cons (match-beginning 2) (match-end 2)))

2006 (YaTeX-match-string 1)))))

2007

2008 (defun yahtml-change-begend ()

2009 (let ((tag (yahtml-on-begend-p))

2010 (completion-ignore-case t)

2011 (case-fold-search t)

2012 (p (point)) (q (make-marker))

2013 (default (append yahtml-env-table yahtml-typeface-table))

2014 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2015 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2016 href b1 e1 attr new css)

2017 (cond

2018 (tag

2019 (cond

2020 ((and (string-match "^a$" tag)

2021 (save-excursion

2022 (and

2023 (re-search-backward "<a\\b" nil t)

2024 (progn

2025 (goto-char (match-end 0))

2026 (skip-chars-forward " \t\n")

2027 (setq b1 (point))

2028 (search-forward ">" nil t))

2029 (setq e1 (match-beginning 0))

2030 (goto-char b1)

2031 (re-search-forward "href\\s *=" e1 t)

2032 (>= p (point))

2033 (progn

2034 (goto-char (match-end 0))

2035 (skip-chars-forward " \t\n")

2036 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2037 (< p (match-end 0)))))

2038 (setq b1 (match-beginning 1) e1 (match-end 1)

2039 yahtml-completing-buffer (current-buffer)

2040 ;; yahtml-urls-local is buffer-local, so we must put

2041 ;; that into yahtml-urls here

2042 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2043 href (read-from-minibuffer

2044 "Change href to: " "" yahtml-url-completion-map))

2045 (if (string< "" href)

2046 (progn

2047 ;;(setq href ;??

2048 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2049 (delete-region b1 e1)

2050 (goto-char b1)

2051 (insert href))))

2052 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2053 (if (and (equal attr "class") ;treat "class" attribute specially

2054 (setq css (yahtml-css-get-element-completion-alist tag)))

2055

2056 (setq new (yahtml-read-css css))

2057 ;;other than "class", read parameter normally

2058 (setq new (yahtml-read-parameter attr)))

2059 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2060 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2061 (insert new))

2062 (t

2063 (save-excursion

2064 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2065 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2066 (skip-chars-forward "^A-Za-z")

2067 (set-marker q (point))

2068 (setq p (point))

2069 (yahtml-goto-corresponding-begend)

2070 (or (= (char-after (point)) ?<)

2071 (skip-chars-backward "^<"))

2072 (skip-chars-forward "^A-Za-z")

2073 (if (= (char-after (1- (point))) ?/)

2074 (progn

2075 (set-marker q (point))

2076 (goto-char p)))

2077 (setq tag (let ((completion-ignore-case t))

2078 (YaTeX-cplread-with-learning

2079 (format "Change `%s' to(default %s): "

2080 tag yahtml-last-begend)

2081 'default 'user 'tmp)))

2082 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2083 (if (string= "" tag) (setq tag yahtml-last-begend))

2084 (setq yahtml-last-begend

2085 (or (cdr (assoc tag yahtml-env-table)) tag)

2086 tag yahtml-last-begend)

2087 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2088 (insert (format "%s%s" tag (yahtml-addin tag)))

2089 (goto-char q)

2090 (set-marker q nil)

2091 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2092 (insert tag))))

2093 t))))

2094

2095 (defun yahtml-change-command ()

2096 (let ((p (point)) (case-fold-search t) cmd par new

2097 (beg (make-marker)) (end (make-marker)))

2098 (skip-chars-backward "^<")

2099 (if (and

2100 (looking-at yahtml-command-regexp)

2101 (progn

2102 (set-marker beg (match-beginning 0))

2103 (set-marker end (match-end 0))

2104 t) ;for further work

2105 (progn

2106 (forward-char -1)

2107 (condition-case nil

2108 (forward-list 1)

2109 (error nil))

2110 (< p (point))))

2111 (progn

2112 (goto-char p)

2113 (if (setq par (yahtml-on-assignment-p))

2114 (progn

2115 (setq new (yahtml-read-parameter par))

2116 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2117 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2118 (setq new

2119 (YaTeX-cplread-with-learning

2120 "Change form to: "

2121 'yahtml-form-table 'yahtml-user-form-table

2122 'yahtml-tmp-form-table)))

2123 (delete-region beg end)

2124 (goto-char beg)

2125 (set-marker beg nil)

2126 (set-marker end nil)

2127 (insert new)

2128 t)

2129 (goto-char p)

2130 nil)))

2131

2132 (defun yahtml-change-* ()

2133 "Change current position's HTML tag (set)."

2134 (interactive)

2135 (cond

2136 ((yahtml-change-begend))

2137 ((yahtml-change-command))))

2138

2139 ;;; ---------- commenting ----------

2140

2141 (defun yahtml-comment-region (&optional uncom)

2142 "Comment out region or environment."

2143 (interactive)

2144 (let ((e (make-marker)) be beg p)

2145 (cond

2146 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2147 (setq be (yahtml-on-begend-p))

2148 (save-excursion

2149 (setq p (point))

2150 (if (string-match "^/" be)

2151 (setq beg (progn (forward-line 1) (point)))

2152 (setq beg (progn (beginning-of-line) (point))))

2153 (goto-char p)

2154 (yahtml-goto-corresponding-begend)

2155 (if (string-match "^/" be)

2156 (beginning-of-line)

2157 (forward-line 1))

2158 (set-marker e (point))

2159 ;(comment-region beg (point) (if uncom (list 4)))))

2160 ))

2161 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2162 (setq beg (region-beginning))

2163 (set-marker e (region-end))))

2164 (if yahtml-translate-hyphens-when-comment-region

2165 (let ((yahtml-entity-reference-chars-alist-default nil)

2166 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2167 yahtml-entity-reference-chars-regexp

2168 yahtml-entity-reference-chars-reverse-regexp)

2169 (yahtml-entity-reference-chars-setup)

2170 (funcall

2171 (if uncom 'yahtml-translate-reverse-region

2172 'yahtml-translate-region)

2173 beg e)))

2174 (comment-region beg e (if uncom (list 4)))

2175 (set-marker e nil)))

2176

2177 (defun yahtml-uncomment-region ()

2178 (interactive)

2179 (yahtml-comment-region t))

2180

2181 ;;; ---------- translate to entity references ----------

2182 (defvar yahtml-entity-reference-chars-alist-default

2183 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2184 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2185 "Default translation table from character to entity reference")

2186 (defvar yahtml-entity-reference-chars-alist nil

2187 "*Translation table from character to entity reference")

2188 (defvar yahtml-entity-reference-chars-regexp nil)

2189 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2190

2191 (defun yahtml-entity-reference-chars-setup ()

2192 (let ((list (append yahtml-entity-reference-chars-alist-default

2193 yahtml-entity-reference-chars-alist)))

2194 (setq yahtml-entity-reference-chars-regexp "["

2195 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2196 (while list

2197 (setq yahtml-entity-reference-chars-regexp

2198 (concat yahtml-entity-reference-chars-regexp

2199 (char-to-string (car (car list))))

2200 yahtml-entity-reference-chars-reverse-regexp

2201 (concat yahtml-entity-reference-chars-reverse-regexp

2202 (cdr (car list))

2203 (if (cdr list) "\\|")))

2204 (setq list (cdr list)))

2205 (setq yahtml-entity-reference-chars-regexp

2206 (concat yahtml-entity-reference-chars-regexp "]")

2207 yahtml-entity-reference-chars-reverse-regexp

2208 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2209

2210 (yahtml-entity-reference-chars-setup)

2211

2212 (defun yahtml-translate-region (beg end)

2213 "Translate inhibited literals."

2214 (interactive "r")

2215 (save-excursion

2216 (save-restriction

2217 (narrow-to-region beg end)

2218 (let ((ct (append yahtml-entity-reference-chars-alist

2219 yahtml-entity-reference-chars-alist-default)))

2220 (goto-char beg)

2221 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2222 ;(setq c (preceding-char))

2223 (replace-match

2224 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2225

2226 (defun yahtml-translate-reverse-region (beg end)

2227 "Translate entity references to literals."

2228 (interactive "r")

2229 (save-excursion

2230 (save-restriction

2231 (narrow-to-region beg end)

2232 (let ((ct (append yahtml-entity-reference-chars-alist

2233 yahtml-entity-reference-chars-alist-default))

2234 ec)

2235 (goto-char beg)

2236 (while (re-search-forward

2237 yahtml-entity-reference-chars-reverse-regexp nil t)

2238 ;(setq c (preceding-char))

2239 (setq ec (YaTeX-match-string 1))

2240 (delete-region (match-end 0) (match-beginning 0))

2241 (insert (car (YaTeX-rassoc ec ct))))))))

2242

2243 (defun yahtml-inner-environment-but (exclude &optional quick)

2244 "Return the inner environment but matches with EXCLUDE tag."

2245 (let (e (case-fold-search t))

2246 (save-excursion

2247 (while (and (setq e (YaTeX-inner-environment quick))

2248 (string-match exclude e))

2249 (goto-char (get 'YaTeX-inner-environment 'point))))

2250 e))

2251

2252 ;;; ---------- filling ----------

2253 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2254 (defun yahtml-move-to-column (col &optional force)

2255 (beginning-of-line)

2256 (let ((ccol 0))

2257 (while (and (> col ccol) (not (eolp)))

2258 (if (eq (following-char) ?\<)

2259 (progn

2260 (while (and (not (eq (following-char) ?\>))

2261 (not (eolp)))

2262 (forward-char))

2263 (or (eolp) (forward-char)))

2264 (or (eolp) (forward-char))

2265 (if (eq (preceding-char) ?\t)

2266 (let ((wd (- 8 (% (+ ccol 8) 8))))

2267 (if (and force (< col (+ ccol wd)))

2268 (progn

2269 (backward-char 1)

2270 (insert-char ?\ (- col ccol))

2271 (setq ccol col))

2272 (setq ccol (+ ccol wd))))

2273 (setq ccol (1+ ccol)))

2274 (if (and YaTeX-japan

2275 (or

2276 (and (fboundp 'char-category)

2277 (string-match "[chj]" (char-category (preceding-char))))

2278 (and (fboundp 'char-charset)

2279 (not (eq (char-charset (preceding-char)) 'ascii)))))

2280 (setq ccol (1+ ccol)))))

2281 (if (and force (> col ccol))

2282 (progn

2283 (insert-char ?\ (- col ccol))

2284 col)

2285 ccol)))

2286

2287 (defun yahtml-fill-paragraph (arg)

2288 (interactive "P")

2289 (let*((case-fold-search t) (p (point)) fill-prefix

2290 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2291 indent

2292 (startp (get 'YaTeX-inner-environment 'point))

2293 (prep (string-match "^pre$" e))

2294 (ps1 (if prep (default-value 'paragraph-start)

2295 paragraph-start))

2296 (ps2 (if prep (concat (default-value 'paragraph-start)

2297 "$\\|^\\s *</?pre>")

2298 paragraph-start)))

2299 (save-excursion

2300 (unwind-protect

2301 (progn

2302 (if prep

2303 (fset 'move-to-column 'yahtml-move-to-column))

2304 (save-excursion

2305 (beginning-of-line)

2306 (indent-to-column (yahtml-this-indent))

2307 (setq fill-prefix

2308 (buffer-substring (point) (point-beginning-of-line)))

2309 (delete-region (point) (point-beginning-of-line)))

2310 (fill-region-as-paragraph

2311 (progn (re-search-backward paragraph-start nil t)

2312 (or (save-excursion

2313 (goto-char (match-beginning 0))

2314 (if (looking-at "<")

2315 (forward-list)

2316 (goto-char (match-end 0))

2317 (skip-chars-forward " \t>"))

2318 (if (looking-at "[ \t]*$")

2319 (progn (forward-line 1) (point))))

2320 (point)))

2321 (progn (goto-char p)

2322 (re-search-forward ps2 nil t)

2323 (match-beginning 0))))

2324 (fset 'move-to-column yahtml-saved-move-to-column)))))

2325

2326 ;(defun yahtml-indent-new-commnet-line ()

2327 ; (unwind-protect

2328 ; (progn

2329 ; (fset 'move-to-column 'yahtml-move-to-column)

2330 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2331 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2332

2333 ;;;

2334 ;;; ---------- indentation ----------

2335 ;;;

2336 (defun yahtml-indent-line ()

2337 "Indent a line (faster wrapper)"

2338 (interactive)

2339 (let (indent)

2340 (if (and (save-excursion

2341 (beginning-of-line) (skip-chars-forward "\t ")

2342 (not (looking-at "<")))

2343 (save-excursion

2344 (forward-line -1)

2345 (while (and (not (bobp)) (looking-at "^\\s *$"))

2346 (forward-line -1))

2347 (skip-chars-forward "\t ")

2348 (setq indent (current-column))

2349 (not (looking-at "<"))))

2350 (progn

2351 (save-excursion

2352 (beginning-of-line)

2353 (skip-chars-forward " \t")

2354 (or (= (current-column) indent)

2355 (YaTeX-reindent indent)))

2356 (and (bolp) (skip-chars-forward " \t")))

2357 (yahtml-indent-line-real))))

2358

2359 (defun yahtml-this-indent ()

2361 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2362 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2363 (excludes

2364 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2365 inenv p col peol (case-fold-search t))

2366 (save-excursion

2367 (beginning-of-line)

2368 (setq inenv (or (yahtml-inner-environment-but excludes t)

2369 "html")

2370 col (get 'YaTeX-inner-environment 'indent)

2371 p (get 'YaTeX-inner-environment 'point)

2372 op nil))

2373 (save-excursion

2374 (cond

2375 ((string-match (concat "^\$" envs "\$") inenv)

2376 (save-excursion

2377 (beginning-of-line)

2378 (skip-chars-forward " \t")

2379 (cond ;lookup current line's tag

2380 ((looking-at (concat "</\$" envs "\$>"))

2381 col)

2382 ((looking-at itms)

2383 (+ col yahtml-environment-indent))

2384 ((and yahtml-hate-too-deep-indentation

2385 (looking-at (concat "<\$" envs "\$")))

2386 (+ col (* 2 yahtml-environment-indent)))

2387 ((and (< p (point))

2388 (string-match itemizing-envs inenv)

2389 (save-excursion

2390 (and

2391 (setq op (point))

2392 (goto-char p)

2393 (re-search-forward itms op t)

2394 (progn

2395 (if yahtml-indent-listing-constant

2396 (setq col (+ (current-column)

2397 (if yahtml-faithful-to-htmllint 1 2)))

2398 (skip-chars-forward "^>")

2399 (skip-chars-forward ">")

2400 (skip-chars-forward " \t")

2401 (setq col (if (looking-at "$")

2402 (+ col yahtml-environment-indent)

2403 (current-column))))))))

2404 col)

2405 (t

2406 (+ col yahtml-environment-indent)))))

2407 (t col)))))

2408

2409 (defun yahtml-indent-line-real ()

2410 "Indent current line."

2411 (interactive)

2412 (YaTeX-reindent (yahtml-this-indent))

2413 (if (bolp) (skip-chars-forward " \t"))

2414 (let (peol col inenv)

2415 (if (and (setq inenv (yahtml-on-begend-p))

2416 (string-match

2417 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2418 (save-excursion

2419 (setq peol (point-end-of-line))

2420 (or (= (char-after (point)) ?<)

2421 (progn (skip-chars-backward "^<") (forward-char -1)))

2422 (setq col (current-column))

2423 (if (and (yahtml-goto-corresponding-begend t)

2424 (> (point) peol)) ;if on the different line

2425 (YaTeX-reindent col))))))

2426

2427 ;(defun yahtml-fill-item ()

2428 ; "Fill item HTML version"

2429 ; (interactive)

2430 ; (let (inenv p fill-prefix peol (case-fold-search t))

2431 ; (setq inenv (or (YaTeX-inner-environment) "html")

2432 ; p (get 'YaTeX-inner-environment 'point))

2433 ; (cond

2434 ; ((string-match "^[uod]l" inenv)

2435 ; (save-excursion

2436 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2437 ; (progn

2438 ; (goto-char (match-end 0))

2439 ; (setq col (current-column)))

2440 ; (error "No <li>, <dt>, <dd>")))

2441 ; (save-excursion

2442 ; (end-of-line)

2443 ; (setq peol (point))

2444 ; (newline)

2445 ; (indent-to-column col)

2446 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2447 ; (delete-region (point) peol)

2448 ; (fill-region-as-paragraph

2449 ; (progn (re-search-backward paragraph-start nil t) (point))

2450 ; (progn (re-search-forward paragraph-start nil t 2)

2451 ; (match-beginning 0)))))

2452 ; (t nil))))

2453

2454 ;;;

2455 ;;; ---------- Lint and Browsing ----------

2456 ;;;

2457 (defun yahtml-browse-menu ()

2458 "Browsing menu"

2459 (interactive)

2460 (message "J)weblint p)Browse R)eload...")

2461 (let ((c (char-to-string (read-char))))

2462 (cond

2463 ((string-match "j" c)

2464 (yahtml-lint-buffer (current-buffer)))

2465 ((string-match "[bp]" c)

2466 (yahtml-browse-current-file))

2467 ((string-match "r" c)

2468 (yahtml-browse-reload)))))

2469

2470 (if (fboundp 'wrap-function-to-control-ime)

2471 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2472

2473 (defvar yahtml-lint-buffer "*weblint*")

2474

2475 (defun yahtml-lint-buffer (buf)

2476 "Call lint on buffer BUF."

2477 (require 'yatexprc)

2478 (interactive "bCall lint on buffer: ")

2479 (setq buf (get-buffer buf))

2480 (YaTeX-save-buffers)

2481 (YaTeX-typeset

2482 (concat yahtml-lint-program " "

2483 (file-name-nondirectory (buffer-file-name buf)))

2484 yahtml-lint-buffer "lint" "lint"))

2485

2486 (defun yahtml-file-to-url (file)

2487 "Convert local unix file name to URL.

2488 If no matches found in yahtml-path-url-alist, return raw file name."

2489 (let ((list yahtml-path-url-alist) p url)

2490 (if (file-directory-p file)

2491 (setq file (expand-file-name yahtml-directory-index file))

2492 (setq file (expand-file-name file)))

2493 (if (string-match "^[A-Za-z]:/" file)

2494 (progn

2495 ;; (aset file 1 ?|) ;これは要らないらしい…

2496 (setq file (concat "///" file))))

2497 (while list

2498 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2499 (setq url (cdr (car list))

2500 file (substring file (match-end 0))

2501 url (concat url file)

2502 list nil))

2503 (setq list (cdr list)))

2504 (or url (concat "file:" file))))

2505

2506 (defun yahtml-url-to-path (file &optional basedir)

2507 "Convert local URL name to unix file name."

2508 (let ((list yahtml-path-url-alist) url realpath docroot

2509 (dirsufp (string-match "/$" file)))

2510 (setq basedir (or basedir

2511 (file-name-directory

2512 (expand-file-name default-directory))))

2513 (cond

2514 ((string-match "^/" file)

2515 (while list

2516 (if (file-directory-p (car (car list)))

2517 (progn

2518 (setq url (cdr (car list)))

2519 (if (string-match "\$http://[^/]*\$/" url)

2520 (setq docroot (substring url (match-end 1)))

2521 (setq docroot url))

2522 (cond

2523 ((string-match (concat "^" (regexp-quote docroot)) file)

2524 (setq realpath

2525 (expand-file-name

2526 (substring

2527 file

2528 (if (= (aref file (1- (match-end 0))) ?/)

2529 (match-end 0) ; "/foo"

2530 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2531 (car (car list))))))

2532 (if realpath

2533 (progn (setq list nil)

2534 (if (and dirsufp (not (string-match "/$" realpath)))

2535 (setq realpath (concat realpath "/")))))))

2536 (setq list (cdr list)))

2537 realpath)

2538 (t file))))

2539

2540 (defun yahtml-browse-current-file ()

2541 "Call WWW browser on current file."

2542 (interactive)

2543 (basic-save-buffer)

2544 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2545

2546 (defun yahtml-browse-reload ()

2547 "Send `reload' event to netzscape."

2548 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2549 (cond

2550 ((string-match "[Nn]etscape" yahtml-www-browser)

2551 (if (get-buffer pb)

2552 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2553 ;;(or (get 'yahtml-netscape-sentinel 'url)

2554 ;; (error "Reload should be called after Browsing."))

2555 (put 'yahtml-netscape-sentinel 'url

2556 (yahtml-file-to-url (buffer-file-name)))

2557 (basic-save-buffer)

2558 (set-process-sentinel

2559 (setq yahtml-browser-process

2560 (start-process

2561 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2562 (format "%s -remote 'reload'" yahtml-www-browser)))

2563 'yahtml-netscape-sentinel))

2564 (t

2565 (message "Sorry, RELOAD is supported only for Netscape.")))))

2566

2567 ;;; ---------- Intelligent newline ----------

2568 (defun yahtml-intelligent-newline (arg)

2569 "Intelligent newline for HTML"

2570 (interactive "P")

2571 (let (env func)

2572 (end-of-line)

2573 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2574 "html")))

2575 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2576 (newline)

2577 (if (and env func (fboundp func))

2578 ;; if intelligent line function is defined, call that

2579 (funcall func)

2580 ;; else do the default action

2581 (if (string-match yahtml-p-prefered-env-regexp env)

2582 (yahtml-insert-p)))))

2583

2584 (defun yahtml-intelligent-newline-ul ()

2585 (interactive)

2586 (yahtml-insert-single "li")

2587 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2588 (yahtml-indent-line))

2589

2590 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2591

2592 (defun yahtml-intelligent-newline-dl ()

2593 (interactive)

2594 (let ((case-fold-search t))

2595 (if (save-excursion

2596 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2597 (get 'YaTeX-inner-environment 'point) t))

2598 (cond

2599 ((match-beginning 2)

2600 (yahtml-insert-single "dd")

2601 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2602 (setq yahtml-last-single-cmd "dt"))

2603 ((match-beginning 3)

2604 (yahtml-insert-single "dt")

2605 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2606 (setq yahtml-last-single-cmd "dd")))

2607 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

2608 (setq yahtml-last-single-cmd "dd"))

2609 (yahtml-indent-line)

2610 (and (string-match yahtml-p-prefered-env-regexp "dl")

2611 (string-equal yahtml-last-single-cmd "dt")

2612 (yahtml-insert-p nil))))

2613

2614 (defun yahtml-intelligent-newline-select ()

2615 (interactive)

2616 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2617 (yahtml-indent-line))

2618

2619 (defun yahtml-intelligent-newline-style ()

2620 (interactive)

2621 (if (save-excursion

2622 (and

2623 (re-search-backward "<style\\|<!-- " nil t)

2624 (looking-at "<style")))

2625 (let (c)

2626 (yahtml-indent-line)

2627 (setq c (current-column))

2628 (insert "<!--\n")

2629 (YaTeX-reindent c)

2630 (insert "-->")

2631 (beginning-of-line)

2632 (open-line 1)

2633 (YaTeX-reindent c))))

2634

2635 (defun yahtml-intelligent-newline-head ()

2636 (let ((title (read-string "Document title: "))

2637 (b "<title>") (e "</title>") p)

2638 (yahtml-indent-line)

2639 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2640 (setq p (point))

2641 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2642 (if (string= "" title) (goto-char p))

2643 (setq yahtml-last-begend "body")))

2644

2645 (defun yahtml-intelligent-newline-script ()

2646 (let ((p (point)) b)

2647 (if (save-excursion

2648 (and

2649 (setq b (re-search-backward "<script\\>" nil t))

2650 (re-search-forward

2651 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2652 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2653 c (srcp (re-search-backward "src=" b t)))

2654 (goto-char p)

2655 (yahtml-indent-line)

2656 (setq c (current-column))

2657 (if srcp

2658 nil

2659 (insert "")

2660 (beginning-of-line)

2661 (open-line 1)

2662 (YaTeX-reindent c))))))

2663

2664 (defun yahtml-intelligent-newline-table ()

2665 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2666 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2667 (cond

2668 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2669 (while (and (setq rb (re-search-backward ptn tb t))

2670 (match-beginning 1))

2671 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2672 (goto-char (match-end 0))

2673 (skip-chars-forward " \t\n")

2674 (if (and (search-forward "colspan\\s *=" p t)

2675 (progn

2676 (skip-chars-forward "\"' \t\n")

2677 (looking-at "[0-9]+")))

2678 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2679 (setq cols (1+ cols)))

2680 (goto-char rb)

2681 (setq p (point)))

2682 (if (> cols 0)

2683 (message "%s columns found. %s"

2684 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2685 "New tr?(N) or Duplicate")))

2686 (cond

2687 ((and (> cols 0)

2688 (memq (read-char) '(?d ?D))) ;Duplication mode

2689 (setq line (YaTeX-buffer-substring (point) cp)))

2690 (t ;empty cells

2691 (setq line "<tr>" i 0)

2692 (if (> cols 0)

2693 (while (> cols i)

2694 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2695 "<td></td>"))

2696 th nil i (1+ i)))

2697 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2698 (while (string-match "t\$h\$\\|td" fmt i)

2699 (setq line (concat line (if (match-beginning 1) "<th></th>"

2700 "<td></td>"))

2701 i (match-end 0))))

2702 (setq line (concat line "</tr>"))))

2703 (goto-char cp)

2704 (if th

2705 (message

2706 "Type `%s' to change td from/to th."

2707 (key-description (car (where-is-internal 'yahtml-change-*)))))

2708 (if (string< "" line)

2709 (progn

2710 (insert line)

2711 (goto-char (+ 8 cp))

2712 (yahtml-indent-line)))))))

2713

2714 ;;; ---------- Marking ----------

2715 (defun yahtml-mark-begend ()

2716 "Mark current tag"

2717 (interactive)

2718 (YaTeX-beginning-of-environment)

2719 (let ((p (point)))

2720 (save-excursion

2721 (skip-chars-backward " \t" (point-beginning-of-line))

2722 (if (bolp) (setq p (point))))

2723 (push-mark p t))

2724 (yahtml-goto-corresponding-begend)

2725 (forward-list 1)

2726 (if (eolp) (forward-char 1)))

2727

2728 ;;; ---------- complete marks ----------

2729 (defun yahtml-complete-mark ()

2730 "Complete &gt, &lt, &ampersand, and &quote."

2731 (interactive)

2732 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2733 (let ((c (read-char)))

2734 (setq c (if (or (< c ?0) (> c ?7))

2735 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2736 (- c ?1)))

2737 (if (or (< c 0) (> c 6))

2738 nil

2739 (insert (format "&%s;"

2740 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2741

2742

2743 ;;; ---------- jump to error line ----------

2744 (defun yahtml-prev-error ()

2745 "Jump to previous error seeing lint buffer."

2746 (interactive)

2747 (or (get-buffer yahtml-lint-buffer)

2748 (error "No lint program ran."))

2749 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2750 (yahtml-jump-to-error-line t))

2751

2752 (defun yahtml-jump-to-error-line (&optional sit)

2753 (interactive "P")

2754 (let ((p (point)) (e (point-end-of-line)))

2755 (end-of-line)

2756 (if (re-search-backward yahtml-error-line-regexp nil t)

2757 (let ((f (if (string= "" (YaTeX-match-string 1))

2758 YaTeX-current-file-name

2759 (YaTeX-match-string 1)))

2760 (l (string-to-int (or (YaTeX-match-string 2)

2761 (YaTeX-match-string 3)))))

2762 (if sit (sit-for 1))

2763 (forward-line -1)

2764 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2765 (goto-line l))

2766 (message "No line number usage"))))

2767

2768 ;;; ---------- Style Sheet Support ----------

2769 (defvar yahtml-css-class-alist nil

2770 "Alist of elements vs. their classes")

2771

2772 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2773 (save-excursion

2774 (save-restriction

2775 (narrow-to-region beg end)

2776 (goto-char (point-min))

2777 (let ((alist initial) b e element class a)

2778 (setq b (point))

2779 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2780 (if (match-beginning 2)

2781 (let ((f (YaTeX-buffer-substring

2782 (progn (skip-chars-forward "^\"")(1+ (point)))

2783 (progn (forward-char 1)

2784 (skip-chars-forward "^\"")(point)))))

2785 (if (file-exists-p f)

2786 (setq alist

2787 (append alist (yahtml-css-collect-classes-file f)))))

2788 (setq e (point))

2789 (goto-char b)

2790 (while (re-search-forward ;ちょといい加減なREGEXP

2791 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2792 e t)

2793 (setq element (YaTeX-match-string 1)

2794 class (YaTeX-match-string 2))

2795 ;;if starts with period (match-string 1 is nil),

2796 ;;this is global class

2797 (setq element (downcase (or element "*")))

2798 (if (setq a (assoc element alist))

2799 (or (assoc class (cdr a))

2800 (setcdr a (cons (list class) (cdr a))))

2801 (setq alist (cons (list element (list class)) alist))))

2802 (goto-char (1- e))

2803 (search-forward "}" nil t)

2804 (setq b (point))))

2805 alist))))

2806

2807 (defun yahtml-css-collect-classes-buffer (&optional initial)

2808 (interactive)

2809 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2810

2811 (defun yahtml-css-collect-classes-file (file &optional initial)

2812 (let*((hilit-auto-highlight nil)

2813 (buf (get-buffer-create

2814 (format " *css-collection*%s" (file-name-nondirectory file))))

2815 (cb (current-buffer)))

2816 (unwind-protect

2817 (progn

2818 (set-buffer buf)

2819 (insert-file-contents file)

2820 (cd (or (file-name-directory file) "."))

2821 (yahtml-css-collect-classes-buffer initial))

2822 (if (eq buf cb)

2823 nil

2824 (kill-buffer buf)

2825 (set-buffer cb)))))

2826

2827 (defun yahtml-css-scan-styles ()

2828 (save-excursion

2829 (goto-char (point-min))

2830 (set (make-local-variable 'yahtml-css-class-alist) nil)

2831 (let (b tag type e href alist)

2832 (while (re-search-forward "<\$style\\|link\$" nil t)

2833 (setq b (match-beginning 0)

2834 tag (YaTeX-match-string 1))

2835 (cond

2836 ((string-match "style" tag)

2837 (goto-char b)

2838 (save-excursion (forward-list 1) (setq e (point)))

2839 (cond

2840 ((search-forward "text/css" e 1) ;css definition starts

2841 (setq alist

2842 (yahtml-css-collect-classes-region

2843 (point) (progn (search-forward "</style>") (point))

2844 alist)))))

2845 ((and (string-match "link" tag)

2846 (stringp (setq type (yahtml-get-attrvalue "type")))

2847 (string-match "text/css" type)

2848 (setq href (yahtml-get-attrvalue "href"))

2849 (file-exists-p (yahtml-url-to-path href)))

2850 (setq alist

2851 (yahtml-css-collect-classes-file

2852 (yahtml-url-to-path href) alist))))

2853 (setq yahtml-css-class-alist alist)))))

2854

2855 (defun yahtml-css-get-element-completion-alist (element)

2856 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

2857 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

2858 (and (or alist global)

2859 (append alist global))))

2860

2861 ;;; ---------- ----------

2862

2863 ;;;

2864 ;;hilit19

2865 ;;;

2866 (defvar yahtml-default-face-table

2867 '(

2868 (form black/ivory white/hex-442233 italic)

2869 ))

2870 (defvar yahtml-hilit-patterns-alist

2871 '(

2872 'case-fold

2873 ;; comments

2874 ("" comment)

2875 ;; include&exec

2876 ("" include)

2877 ;; string

2878 (hilit-string-find ?\\ string)

2879 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

2880 ("</?[uod]l>" 0 decl)

2881 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2882 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

2883 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

2884 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

2885 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2886 ))

2887

2888 (defun yahtml-hilit-region-tag (tag)

2889 "Return list of start/end point of <TAG> form."

2890 (if (re-search-forward tag nil t)

2891 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

2892 (elm (YaTeX-match-string 1)))

2893 (skip-chars-forward "^>")

2894 (prog1

2895 (cons (1+ (point))

2896 (progn (re-search-forward (concat "</" elm ">") nil t)

2897 (match-beginning 0)))

2898 (goto-char e0)))))

2899

2900 (defun yahtml-hilit-region-tag-itself (ptn)

2901 "Return list of start/end point of <tag options...> itself."

2902 (if (re-search-forward ptn nil t)

2903 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

2904 (skip-chars-forward "^<>")

2905 (if (eq (char-after (point)) ?<) nil

2906 (prog1

2907 (cons m0 (min (point-max) (1+ (point))))

2908 (goto-char e0))))))

2909

2910 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2911 (and yahtml-use-hilit19

2912 (or (assq 'yahtml-mode hilit-patterns-alist)

2913 (setq hilit-patterns-alist

2914 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2915 hilit-patterns-alist))))

2916 ;;;

2917 ;; for font-lock

2918 ;;;

2919

2920 ; <<STATIC KEYWORDS BELOW NOT USED>>

2921 ;(defvar yahtml-font-lock-keywords

2922 ; '(

2923 ; ;; comments

2924 ; ("" . font-lock-comment-face)

2925 ; ;; include&exec

2926 ; (""

2927 ; 0 font-lock-include-face keep)

2928 ; ;; string

2929 ; ;(hilit-string-find ?\\ string)

2930 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2931 ; ("</?[uod]l>" 0 font-lock-keyword-face)

2932 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

2933 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

2934 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2935 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

2936 ; )

2937 ; "*Defualt font-lock-keywords for yahtml-mode.")

2938 (defvar yahtml-font-lock-keywords

2939 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

2940 "Default fontifying patterns for yahtml-mode")

2941

2942 (defun yahtml-font-lock-set-default-keywords ()

2943 (put 'yahtml-mode 'font-lock-defaults

2944 '(yahtml-font-lock-keywords nil t)))

2945

2946 (if yahtml-use-font-lock

2947 (progn

2948 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

2949 ;;for those who use both hilit19 and font-lock

2950 (if (eq (car hilit-mode-enable-list) 'not)

2951 (or (member 'yahtml-mode hilit-mode-enable-list)

2952 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

2953 (setq hilit-mode-enable-list

2954 (delq 'yahtml-mode hilit-mode-enable-list))))

2955 (yahtml-font-lock-set-default-keywords)))

2956

2957 (defun yahtml-font-lock-recenter (&optional arg)

2958 (interactive "P")

2959 (font-lock-mode -1) ;is stupid, but sure.

2960 (font-lock-mode 1))

2961

2962 ;; (defun yahtml-fontify-to-tagend (lim)

2963 ;; "*Fontify any tag including < and >.

2964 ;; This is invalid use of font-lock function. Therefore

2965 ;; this fontifying will loose effectiveness soon or later."

2966 ;; (let ((start (match-beginning 0))

2967 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))

2968 ;; (or nil; (font-lock-any-faces-p start end)

2969 ;; (font-lock-fillin-text-property

2970 ;; start end 'face 'font-lock font-lock-keyword-face)))

2971 ;; nil)

2972

2973 (run-hooks 'yahtml-load-hook)

2974 (provide 'yahtml)

2975

2976 ; Local variables:

2977 ; fill-prefix: ";;; "

2978 ; paragraph-start: "^$\\|\\|;;;$"

2979 ; paragraph-separate: "^$\\|\\|;;;$"

2980 ; coding: sjis

2981 ; End: