yatex: 0734be649cb8 yahtml.el

yatex

view yahtml.el @ 79:0734be649cb8

Do not care file-coding-system when YaTeX-kanji-code is nil. New completion yatexpkg.el is introduced.

author	yuuji
date	Thu, 25 Dec 2003 04:10:32 +0000
parents	1b172d26b55e
children	9b4354af748c

line source

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

3 ;;; Last modified Mon Nov 17 18:28:50 2003 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.70"

7 "Revision number of running yahtml.el")

9 ;;;[Installation]

10 ;;;

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

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

13 ;;;

14 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

23 ;;;

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

25 ;;;

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

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

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

29 ;;;

30 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

39 ;;;

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

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

42 ;;;

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

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

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

46 ;;;

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

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

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

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

51 ;;;

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

53 ;;;

54 ;;;[Commentary]

55 ;;;

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

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

58 ;;;

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

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

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

62 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

87 ;;; change the reference link with completion.

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

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

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

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

92 ;;; is "netscape")

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

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

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

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

97 ;;; in the region.

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

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

100 ;;; URLencoded string in the region.

101 ;;;

102 ;;;[キーの説明]

103 ;;;

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

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

106 ;;;

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

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

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

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

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

112 ;;; できます。

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

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

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

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

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

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

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

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

121 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

133 ;;; す。

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

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

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

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

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

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

140 ;;; きます。

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

142 ;;; す。

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

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

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

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

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

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

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

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

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

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

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

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

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

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

157 ;;;

158 ;;; [謝辞]

159 ;;;

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

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

162 ;;;

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

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

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

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

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

168 ;;;

169

170

171 ;(require 'yatex)

172 (require 'yatexlib)

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

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

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

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

177 (defvar yahtml-www-browser "netscape"

178 "*WWW Browser command")

179 (defvar yahtml-kanji-code 2

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

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 nil

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

213

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

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

216

217 (defvar yahtml-template-file "~/http/template.html"

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

219

220 (defvar yahtml-prefer-upcases nil

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

222

223 (defvar yahtml-prefer-upcase-attributes nil

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

225

226 (defvar yahtml-server-type 'apache

227 "*WWW server program type")

228

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

230 "*Server access file name for apache")

231

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

233

234 (defvar yahtml-image-inspection-bytes 10000 ;256

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

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

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

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

239 %f: filename")

240

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

242 (defvar yahtml-error-line-regexp

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

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

245

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

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

248 (defvar yahtml-escape-chars 'ask

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

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

251 at each reserved chars.")

252

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

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

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

256

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

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

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

260

261 (defvar yahtml-mode-abbrev-table nil

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

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

264

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

266 "*Boundary regexp for indentation calculation.")

267

268 ;;; --- customizable variable ends here ---

269 (defvar yahtml-prefix-map nil)

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

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

272 (defvar yahtml-shell-command-option

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

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

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

276

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

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

279 (YaTeX-define-key

280 key

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

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

283 map))

284

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

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

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

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

289

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

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

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

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

294 (if YaTeX-inhibit-prefix-letter nil

295 (yahtml-define-begend-region-key

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

297

298 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

310 (let ((map yahtml-prefix-map))

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

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

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

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

315 (and YaTeX-emacs-19 window-system

316 (progn

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

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

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

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

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

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

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

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

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

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

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

328 (if YaTeX-no-begend-shortcut

329 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

347 (yahtml-define-begend-key "bS" "div" map)

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

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

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

351 )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

366 )

367 (substitute-all-key-definition

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

369 (substitute-all-key-definition

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

371

372 (if yahtml-lint-buffer-map nil

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

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

375

376

377 (defvar yahtml-paragraph-start

378 (concat

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

380 "*Regexp of html paragraph separater")

381 (defvar yahtml-paragraph-separate

382 (concat

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

384 "*Regexp of html paragraph separater")

385 (defvar yahtml-syntax-table nil

386 "*Syntax table for yahtml-mode")

387

388 (if yahtml-syntax-table nil

389 (setq yahtml-syntax-table

390 (make-syntax-table (standard-syntax-table)))

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

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

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

394 )

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

396 "Regexp of constituent of html commands.")

397

398 ;;; Completion tables for `form'

399 (defvar yahtml-form-table

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

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

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

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

404

405 (defvar yahtml-env-table

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

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

408 ("OrderedList" . "ol")

409 ("UnorderedList" . "ul")

410 ("DefinitionList" . "dl")

411 ("Preformatted" . "pre")

412 ("table") ("thead") ("tbody") ("tfoot") ("caption") ("tr") ("th") ("td")

413 ("address")

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

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

416 ("style") ("div") ("object")

417 ))

418

419 ;(defvar yahtml-itemizing-regexp

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

421 ; "Regexp of itemizing forms")

422

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

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

425

426 ;;; Completion tables for typeface designator

427 (and yahtml-always-/p

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

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

430

431 (defvar yahtml-typeface-table

432 (append

433 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("strike") ("s")

434 ("strong") ("var") ("b") ("i") ("tt") ("u") ("big") ("small") ("font")

435 ("sup") ("sub") ("span"))

436 yahtml-env-table)

437 "Default completion table of typeface designator")

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

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

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

441

442 (defvar yahtml-single-cmd-table

443 '(("hr") ("br") ("option") ("p")

444 ("HorizontalLine" . "hr")

445 ("BreakLine" . "br")

446 ("Paragraph" . "p")

447 ("Item" . "li")

448 ("DefineTerm" . "dt")

449 ("Description" . "dd")

450 ("dd") ("dt") ("li")

451 )

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

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

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

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

456

457 (defvar yahtml-current-completion-type nil

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

459

460 ;(defvar yahtml-struct-name-regexp

462 (defvar yahtml-struct-name-regexp

463 (concat

464 "\\<\\("

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

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

467 "\\)\\b")

468 "Regexp of structure beginning.")

469

470 (defvar yahtml-closable-regexp

471 (concat

472 "\\<\\("

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

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

475 "\\)\\b")

476 "Regexp of any closable elemnts.")

477

478 (defvar yahtml-indent-listing-constant t

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

480 T for static indentation depth")

481

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

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

484

485

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

487 (cond

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

489 buffer-file-name)

490 (let ((dir default-directory)

491 charset af ext (ldir "")

492 line

493 (case-fold-search t)

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

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

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

497 (while (and dir

498 (not (string= dir ldir))

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

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

501 (if (file-exists-p af)

502 (save-excursion

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

504 (save-excursion

505 (goto-char (point-min))

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

507 (setq line (buffer-substring

508 (point-beginning-of-line)

509 (point-end-of-line))

510 dir nil)))

511 (kill-buffer (current-buffer))))

512 (if dir

513 (setq ldir dir

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

515 dir (file-name-directory dir))))

516 line

517 ))

518 (t nil))

519 )

520

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

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

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

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

525 (case-fold-search t)

526 line

527 charset)

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

529 (progn

530 (string-match ptn line)

531 (setq charset

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

533 (cond

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

535 (setq charset 2))

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

537 (setq charset 3))

538 ((string-match "shift_jis" charset)

539 (setq charset 1))

540 (t (setq charset nil)))

541 (setq dir "")))

542 (if (featurep 'mule)

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

544 charset))

545

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

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

548 x index-list)

549 ;;s/\\s *$//;

550 (if line

551 (progn

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

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

554 (while (string< "" line)

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

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

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

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

559 line ""))

560 )

561 (or (nreverse index-list)

562 (if (listp yahtml-directory-index)

563 yahtml-directory-index

564 (list yahtml-directory-index)))))))

565

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

567 (defun yahtml-mode ()

568 (interactive)

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

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

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

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

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

574 (cond

575 ((null coding) nil)

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

577 (setq buffer-file-coding-system

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

579 (save-excursion (set-auto-coding buffer-file-name (buffer-size))))

580 coding)))

581 ((featurep 'mule)

582 (set-file-coding-system coding))

583 ((boundp 'NEMACS)

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

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

586 (setq major-mode 'yahtml-mode

587 mode-name "yahtml"

588 YaTeX-current-file-name (file-name-nondirectory

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

590 local-abbrev-table yahtml-mode-abbrev-table)

591 (mapcar

592 (function (lambda (x)

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

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

595 (boundp (cdr x)))

596 (symbol-value (cdr x))

597 (cdr x)))))

598 '((YaTeX-ec . "")

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

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

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

602 (YaTeX-comment-prefix . "<!--")

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

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

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

606 (paragraph-start . yahtml-paragraph-start)

607 (paragraph-separate . yahtml-paragraph-separate)

608 (comment-start . "")

609 (comment-start-skip . comment-start)

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

611

612 (if yahtml-use-font-lock

613 (progn

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

615 (or (featurep 'xemacs)

616 (progn

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

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

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

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

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

622 (font-lock-fontify-buffer)

623 ))

624 ))

625 (set-syntax-table yahtml-syntax-table)

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

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

628 (yahtml-css-scan-styles)

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

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

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

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

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

634

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

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

637 font-lock-defaults)

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

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

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

641

642 (defun yahtml-version ()

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

644 (interactive)

645 (message

646 (concat "Yet Another HTML-mode "

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

648 " Revision "

649 yahtml-revision-number)))

650

651 (defun yahtml-quit ()

652 (interactive)

653 (and yahtml-mode-old-mode

654 (fboundp yahtml-mode-old-mode)

655 (funcall yahtml-mode-old-mode)))

656

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

658 (cond

659 ((featurep 'xemacs)

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

661 (set keymap nil)

662 (mapcar

663 (function

664 (lambda (bind)

665 (setq bind (cdr bind))

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

667 (setcar (cdr bind) 'progn))

668 (if (stringp (car (cdr bind)))

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

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

671 (symbol-value keymap))))))

672 bindlist)

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

674 (t

675 (mapcar

676 (function

677 (lambda (bind)

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

679 bindlist))))

680

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

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

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

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

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

686

687 ;;; Variables for mosaic url history

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

689 (defvar yahtml-urls-private nil)

690 (defvar yahtml-urls-local nil)

691

692 (cond

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

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

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

696 (YaTeX-define-menu

697 'yahtml-menu-map-sectioning

698 (nreverse

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

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

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

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

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

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

705 )))

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

707 (YaTeX-define-menu

708 'yahtml-menu-map-logical

709 (nreverse

710 '((em "Embolden" .

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

712 (dfn "Define a word" .

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

714 (cite "Citation" .

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

716 (code "Code" .

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

718 (kbd "Keyboard" .

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

720 (samp "Sample display" .

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

722 (strong "Strong" .

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

724 (VAR "Variable notation" .

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

726 )))

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

728 (YaTeX-define-menu

729 'yahtml-menu-map-typeface

730 (nreverse

731 '((b "Bold" .

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

733 (i "Italic" .

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

735 (tt "Typewriter" .

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

737 (u "Underlined" .

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

739 )))

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

741 (YaTeX-define-menu

742 'yahtml-menu-map-listing

743 (nreverse

744 '((ul "Unordered" .

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

746 (ol "Ordered" .

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

748 (dl "Definition" .

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

750 )))

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

752 (YaTeX-define-menu

753 'yahtml-menu-map-item

754 (nreverse

755 '((li "Simple item" .

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

757 (dt "Define term" .

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

759 (dd "Description of term" .

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

761 )))

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

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

764 (YaTeX-define-menu

765 'yahtml-menu-map

766 (nreverse

767 (list

768 (cons (list 'sect "Sectioning")

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

770 (cons (list 'list "Listing")

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

772 (cons (list 'item "Item")

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

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

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

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

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

778 )))

779 (if (featurep 'xemacs)

780 (add-hook 'yahtml-mode-hook

781 '(lambda ()

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

783 (progn

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

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

786 ))

787

788 ;;; ----------- Completion ----------

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

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

791 "Insert <cmd> ... </cmd>."

792 (interactive "P")

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

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

795 (cmd

796 (or env

797 (YaTeX-cplread-with-learning

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

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

800 (bolp (save-excursion

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

802 (cc (current-column)))

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

804 (setq yahtml-last-begend

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

806 yahtml-last-begend))

807 (setq cmd yahtml-last-begend)

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

809 (if region

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

811 ;; to enable continuous regioning by another environment

812 (let ((beg (region-beginning))

813 (end (region-end))

814 (addin (yahtml-addin cmd)))

815 (save-excursion

816 (goto-char end)

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

818 (goto-char beg)

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

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

821 (save-excursion

822 (insert "\n")

823 (indent-to-column cc)

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

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

826 (newline)

827 (yahtml-intelligent-newline nil))

828 (yahtml-indent-line))))

829

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

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

832 (interactive)

833 (yahtml-insert-begend t))

834

835

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

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

838 (interactive)

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

840 (or form

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

842 (setq form

843 (YaTeX-cplread-with-learning

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

845 'yahtml-form-table 'yahtml-user-form-table

846 'yahtml-tmp-form-table))))

847 (let ((p (point)) q)

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

849 (setq yahtml-last-form form)

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

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

852 ;;(indent-relative-maybe)

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

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

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

856

857 ;;; ---------- Add-in ----------

858 (defun yahtml-addin (form)

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

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

861 (concat

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

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

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

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

866 "class"

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

868 (completing-read "class: " a))))

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

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

871 (string< "" s))

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

873 ""))))

874

875 (defvar yahtml-completing-buffer nil)

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

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

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

879 (let (list end)

880 (save-excursion

881 (set-buffer yahtml-completing-buffer)

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

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

884 (save-excursion

885 (goto-char (point-min))

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

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

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

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

890 (setq end (match-end 0))

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

892 (yahtml-on-assignment-p)

893 (progn

894 (goto-char end)

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

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

897 (setq list (cons

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

899 list))))

900 list)))

901 )

902

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

904 (if yahtml-url-completion-map nil

905 (setq yahtml-url-completion-map

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

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

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

909 )

910

911 (defun yahtml-complete-url ()

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

913 (interactive)

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

915 (lim (YaTeX-minibuffer-begin))

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

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

918 (cond

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

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

921 listfunc (list 'lambda nil

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

923 beg min))

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

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

926 (progn

927 (setq path (substring initial 0 beg))

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

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

930 (setq initial (substring initial beg))

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

932 cmpl (try-completion initial labels)

933 listfunc (list 'lambda ()

934 (list 'all-completions

935 initial (list 'quote labels)))

936 beg (+ min beg)))

937 (t

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

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

940 initial))

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

942 file (file-name-nondirectory path)

943 initial file

944 cmpl (file-name-completion file dir)

945 listfunc (list 'lambda nil

946 (list 'file-name-all-completions

947 file dir))

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

949 (cond

950 ((stringp cmpl)

951 (if (string= initial cmpl)

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

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

954 (princ

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

956 (delete-region (point) beg)

957 (insert cmpl)))

958 ((null cmpl)

959 (ding))

960 ((eq t cmpl)

961 (save-excursion

962 (unwind-protect

963 (progn

964 (goto-char p)

965 (insert " [Sole completion]"))

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

967

968 ;

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

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

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

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

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

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

975 ;

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

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

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

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

980 (defvar yahtml-unsafe-chars-regexp

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

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

983 ;

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

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

986 ;

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

988 ; "$" | ","

989 (defvar yahtml-unreserved-chars-regexp

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

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

992 Not used yet.")

993

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

995 "Translate reserved chars to URL encoded string."

996 (let ((p 0) (target "")

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

998 (cond

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

1000 (t

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

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

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

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

1005 (setq target (concat target

1006 (substring str 0 p)

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

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

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

1010 (concat target str)))))

1011

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

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

1014 (interactive "r")

1015 (save-excursion

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

1017 (goto-char beg)

1018 (while (and (< (point) e)

1019 (re-search-forward

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

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

1022 (sit-for 0)

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

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

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

1026 ; (unwind-protect

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

1028 ; (save-excursion

1029 ; (backward-char 1)

1030 ; (delete-backward-char 4))

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

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

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

1034 (progn

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

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

1037 (set-marker e nil))))

1038 ;; ab%defgls/.|

1039

1040 (defun yahtml:a ()

1041 "Add-in function for <a>"

1042 (let ((href ""))

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

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

1045 href (yahtml-escape-chars-string

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

1047 (prog1

1048 (concat (yahtml-make-optional-argument

1049 "href" href)

1050 (yahtml-make-optional-argument

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

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

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

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

1055 (YaTeX-update-table

1056 (list href)

1057 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

1058 )))

1059

1060 (defvar yahtml-parameters-completion-alist

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

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

1063 ("src" . file)

1064 ("background" . file)

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

1066 ("method" ("POST") ("GET"))

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

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

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

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

1071 ("http-equiv" ("Refresh"))))

1072

1073 (defvar yahtml-link-types-alist

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

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

1076 ("subsection") ("appendix") ("help") ("bookmark")))

1077

1078 (defvar yahtml-content-types-alist

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

1080 ("text/sgml") ("text/xml")

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

1082 ("application/java")

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

1084 "Alist of content-types")

1085

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

1087 (let* ((alist

1088 (cdr-safe (assoc (downcase par)

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

1090 (prompt (concat par ": "))

1091 v)

1092 (cond

1093 ((eq alist 'file)

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

1095 ((and alist (symbolp alist))

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

1097 (alist

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

1099 (t

1100 (read-string prompt default)))))

1101

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

1103 "Make optional argument string."

1104 (if (string= "" arg)

1105 ""

1106 (concat " "

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

1108 "=\"" arg "\"")))

1109

1110 (defun yahtml:body ()

1111 "Add-in function for <body>"

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

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

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

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

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

1117 (concat

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

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

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

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

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

1123

1124 (defun yahtml:img ()

1125 "Add-in function for <img>"

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

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

1128 alt

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

1130 (l yahtml-prefer-upcase-attributes)

1131 info width height bytes comments)

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

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

1134 (car info)

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

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

1137 bytes (car (cdr (cdr info)))

1138 comments (nth 4 info)))

1139 (if info

1140 (setq alt

1141 (YaTeX-replace-formats

1142 yahtml:img-default-alt-format

1143 (list (cons "x" width)

1144 (cons "y" height)

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

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

1147 (cons "c" (car comments))))))

1148

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

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

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

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

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

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

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

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

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

1158

1159 (defun yahtml-file-truename (file)

1160 (cond

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

1162 (t (let ((new file))

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

1164 (not (equal new file)))

1165 (setq file new))

1166 file))))

1167

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

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

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

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

1172 (let ((mlt 1)

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

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

1175 (value 0))

1176 (while (> length 0)

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

1178 pos (+ pos direc)

1179 mlt (* mlt 256)

1180 length (1- length)))

1181 value))

1182

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

1184 "Return the information on the image file FILE.

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

1186 (save-excursion

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

1188 width height bytes depth comment

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

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

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

1192 (seekpoint 1)

1193 c1 c2 c3 c4 beg end

1194 (case-fold-search nil))

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

1196 (set-buffer tmpbuf)

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

1198 (erase-buffer)

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

1200 (unwind-protect

1201 (progn

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

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

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

1205 (YaTeX-insert-file-contents

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

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

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

1209 c2 (char-after 2)

1210 c3 (char-after 3)

1211 c4 (char-after 4))

1212 (cond

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

1214 ;;JPEG images need JPEG markers inspection

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

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

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

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

1219 (catch 'exit

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

1221 (cond

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

1223 ;maybe corrupted, exit from loop

1224 (throw 'exit t))

1225 ((memq

1226 (char-after (1+ seekpoint))

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

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

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

1230 ;;found!

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

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

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

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

1235 ;; JPEG comment area

1236 (setq beg (+ seekpoint 2 2)

1237 end (+ seekpoint

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

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

1240 (t ;other markers

1241 nil)) ;just skip it

1242 (setq seekpoint (+ seekpoint 2)

1243 seekpoint (+ seekpoint

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

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

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

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

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

1249 height (yahtml-hex-value 20 4)

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

1251 ((looking-at "GIF8")

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

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

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

1255 ((looking-at "BM")

1256 ;;# OS/2, Windoze BMP files

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

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

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

1260 (cond

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

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

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

1264 (t

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

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

1267 ))

1268 (message "")

1269 (kill-buffer tmpbuf))

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

1271

1272 (defun yahtml:form ()

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

1274 (concat

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

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

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

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

1279 ))

1280

1281 (defun yahtml:select ()

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

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

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

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

1286

1287 (defun yahtml:ol ()

1288 "Add-in function for <ol>"

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

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

1291 (type (completing-read

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

1293 (concat

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

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

1296 (defun yahtml:ul ()

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

1298 (defun yahtml:dl ()

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

1300 (defun yahtml:dt ()

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

1302

1303 (defun yahtml:p ()

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

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

1306 ))

1307

1308 (defvar yahtml-input-types

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

1310 ("reset") ("image") ("hidden") ("file")))

1311

1312 (defun yahtml:input ()

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

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

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

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

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

1318 yahtml-input-types nil t)

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

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

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

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

1323 (concat

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

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

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

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

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

1329 )))

1330

1331 (defun yahtml:textarea ()

1332 "Add-in function for `textarea'"

1333 (interactive)

1334 (let (name rows cols)

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

1336 cols (read-string "Columns: ")

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

1338 (concat

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

1340 "\"" name "\"")

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

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

1343

1344 (defun yahtml:table ()

1345 "Add-in function for `table'"

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

1347 (a (yahtml-read-parameter "align")))

1348 (concat

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

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

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

1352 (defun yahtml:caption ()

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

1354 (let ((yahtml-parameters-completion-alist '(("align" ("top") ("bottom")))))

1355 (yahtml-make-optional-argument "align" (yahtml-read-parameter "align"))))

1356

1357 (defun yahtml:font ()

1358 "Add-in function for `font'"

1359 (concat

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

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

1362

1363 (defun yahtml:style ()

1364 "Add-in function for `style'"

1365 (yahtml-make-optional-argument

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

1367

1368 (defun yahtml:tr ()

1369 "Add-in function for `tr'"

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

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

1372 "")

1373

1374 (defun yahtml:link ()

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

1376 (let (rel rev type href)

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

1378 (cond

1379 ((equal rel "")

1380 (concat (yahtml-make-optional-argument

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

1382 (yahtml-make-optional-argument

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

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

1385 )))

1386 ((string-match "stylesheet" rel)

1387 (concat

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

1389 (yahtml-make-optional-argument

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

1391 (progn

1392 (setq href

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

1394 (if (string< "" href)

1395 (progn

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

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

1398 (setq yahtml-css-class-alist

1399 (yahtml-css-collect-classes-file

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

1401 (message "")

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

1403 (t ;;??

1404 ))))

1405

1406 (defvar yahtml:meta-names

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

1408

1409 (defun yahtml:meta ()

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

1411 "name"

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

1413 http-equiv content)

1414 (if (string= "" name)

1415 (if (string-match

1416 "Content-type"

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

1418 "http-equiv"

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

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

1421 "See docs/qanda")

1422 (concat http-equiv

1423 (yahtml-make-optional-argument

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

1425 (concat

1426 name

1427 (yahtml-make-optional-argument

1428 "content"

1429 (cond

1430 ((string-match "date" name)

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

1432 ((string-match "author" name)

1433 (read-string "Author: "

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

1435 (user-full-name)

1436 (user-login-name))))

1437 ((string-match "GENERATOR" name)

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

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

1440 (message "Thank you!"))

1441 content)

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

1443

1444 (defun yahtml:br ()

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

1446

1447 (defun yahtml:object ()

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

1449 data classid)

1450 (cond

1451 ((string-match "java" codetype)

1452 (let ((completion-ignored-extensions

1453 ;;any extensions except ".class"

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

1455 (setq classid (concat "java:"

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

1457 (concat

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

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

1460 (yahtml-make-optional-argument

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

1462 (yahtml-make-optional-argument

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

1464 (yahtml-make-optional-argument

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

1466 ))

1467 (t

1468 ""

1469 ))))

1470

1471 ;;; ---------- Simple tag ----------

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

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

1474 (interactive "P")

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

1476 (or tag

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

1478 (setq tag

1479 (YaTeX-cplread-with-learning

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

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

1482 'yahtml-typeface-table 'yahtml-user-typeface-table

1483 'yahtml-tmp-typeface-table))))

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

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

1486 (setq yahtml-last-typeface-cmd tag

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

1488 (if region-mode

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

1490 (save-excursion

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

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

1493 (exchange-point-and-mark)

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

1495 (message "No mark set now"))

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

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

1498

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

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

1501 (interactive)

1502 (yahtml-insert-tag t tag))

1503

1504

1505 (defun yahtml-insert-single (cmd)

1506 "Insert <CMD>."

1507 (interactive

1508 (list

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

1510 (YaTeX-cplread-with-learning

1511 (format "Command%s: "

1512 (if yahtml-last-single-cmd

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

1514 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1517 (setq yahtml-last-single-cmd

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

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

1520 yahtml-last-single-cmd))

1521 (insert (format "<%s>" cmd)))

1522

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

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

1525 (interactive "P")

1526 (if arg (yahtml-insert-tag arg "p")

1527 (save-excursion ;insert "/p" first to memorize "p"

1528 (yahtml-insert-single "/p")) ;in the last-completion variable

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

1530

1531 (defun yahtml-insert-amps (arg)

1532 "Insert char-entity references via ampersand"

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

1534 (interactive "P")

1535 (let*((mess "") c

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

1537 yahtml-entity-reference-chars-alist))

1538 (l list))

1539 (while l

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

1541 l (cdr l)))

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

1543 (setq c (read-char))

1544 (cond

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

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

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

1548 (insert "&;")

1549 (forward-char -1))

1550 ((equal c ? )

1551 (insert ?&))

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

1553

1554 ;;; ---------- Jump ----------

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

1556 "Check if point is on href clause."

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

1558 (save-excursion

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

1560 (save-excursion

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

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

1563 (setq e (point)))

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

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

1566 (search-forward "href" e t)

1567 (search-forward "=" e t)

1568 (progn

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

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

1571 (< p (match-end 0))

1572 (YaTeX-match-string 1)

1573 ))))

1574

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

1576 (cond

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

1578 (set-process-buffer proc nil))

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

1580 (let ((cb (current-buffer)))

1581 (set-buffer (process-buffer proc))

1582 (goto-char (point-min))

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

1584 (progn

1585 (message "Starting netscape...")

1586 (start-process

1587 "browser" (process-buffer proc)

1588 shell-file-name yahtml-shell-command-option

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

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

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

1592 (set-buffer cb)))))

1593

1594 (defvar yahtml-browser-process nil)

1595

1596 (defun yahtml-browse-html (href)

1597 "Call WWW Browser to see HREF."

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

1599 (cond

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

1601 (if (get-buffer pb)

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

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

1604 (set-process-sentinel

1605 (setq yahtml-browser-process

1606 (start-process

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

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

1609 'yahtml-netscape-sentinel))

1610 ((and (string-match "[Nn]etscape" yahtml-www-browser)

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

1612 (if (get-buffer pb)

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

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

1615 (set-process-sentinel

1616 (setq yahtml-browser-process

1617 (start-process

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

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

1620 'yahtml-netscape-sentinel))

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

1622 (w3-fetch href))

1623 ((stringp yahtml-www-browser)

1624 (if (and yahtml-browser-process

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

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

1627 (setq yahtml-browser-process

1628 (start-process

1629 "browser" "* WWW Browser *"

1630 shell-file-name yahtml-shell-command-option

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

1632 (t

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

1634

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

1636 "Go to corresponding name."

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

1638 (if href

1639 (cond

1640 ((string-match "^\$ht\\|f\$tp:" href)

1641 (yahtml-browse-html href))

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

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

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

1645 (if (string< "" file)

1646 (progn

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

1648 (or (catch 'dirindex

1649 (mapcar

1650 (function

1651 (lambda (f)

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

1653 (throw 'dirindex

1654 (setq file (concat file f))))))

1655 (yahtml-get-directory-index))

1656 nil)

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

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

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

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

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

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

1663 (if name

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

1665 t)))))

1666

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

1668 "Jump to html's named tag."

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

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

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

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

1673

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

1675 "Check if point is on begend clause."

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

1677 (save-excursion

1678 (goto-char p)

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

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

1681 (looking-at

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

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

1684 )

1685 (condition-case nil

1686 (forward-list 1)

1687 (error nil))

1688 (< p (point)))

1689 (YaTeX-match-string 1)))))

1690

1691 (defun yahtml-goto-corresponding-begend (&optional noerr)

1692 "Go to corresponding opening/closing tag.

1693 Optional argument NOERR causes no error for unballanced tag."

1694 (let ((cmd (yahtml-on-begend-p)) m0

1695 (p (point)) (case-fold-search t) func str (nest 0))

1696 (cond

1697 (cmd

1698 (setq m0 (match-beginning 0))

1699 (if (= (aref cmd 0) ?/) ;on </cmd> line

1700 (setq cmd (substring cmd 1)

1701 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1702 func 're-search-backward)

1703 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1704 func 're-search-forward))

1705 (while (and (>= nest 0) (funcall func str nil t))

1706 (if (equal m0 (match-beginning 0))

1707 nil

1708 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1709 (if (< nest 0)

1710 (goto-char (match-beginning 0))

1711 (funcall

1712 (if noerr 'message 'error)

1713 "Corresponding tag of `%s' not found." cmd)

1714 (goto-char p)

1715 nil))

1716 (t nil))))

1717

1718 (defun yahtml-current-tag ()

1719 "Return the current tag name."

1720 (save-excursion

1721 (let ((p (point)) b tag)

1722 (or (bobp)

1723 (looking-at "<")

1724 (progn (skip-chars-backward "^<") (forward-char -1)))

1725 (setq b (point))

1726 (skip-chars-forward "<")

1727 (setq tag (buffer-substring

1728 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1729 (goto-char b)

1730 (forward-list 1)

1731 (and (< p (point)) tag))))

1732

1733

1734 (defun yahtml-goto-corresponding-img ()

1735 "View image on point"

1736 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1737 (if (and tag

1738 (string-match "img" tag)

1739 (save-excursion

1740 (re-search-backward "<\\s *img" nil t)

1741 (re-search-forward "src=\"?\$[^\"> ]+\$\"?")

1742 (match-beginning 1)

1743 (setq image

1744 (buffer-substring (match-beginning 1) (match-end 1)))))

1745 (progn

1746 (message "Invoking %s %s..." yahtml-image-viewer image)

1747 (start-process

1748 "Viewer" " * Image Viewer *"

1749 shell-file-name yahtml-shell-command-option ;"-c"

1750 (concat yahtml-image-viewer " " image))

1751 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1752

1753 (defun yahtml-get-attrvalue (attr)

1754 "Extract current tag's attribute value from buffer."

1755 (let (e (case-fold-search t))

1756 (save-excursion

1757 (or (looking-at "<")

1758 (progn (skip-chars-backward "^<") (backward-char 1)))

1759 (setq e (save-excursion (forward-list 1) (point)))

1760 (if (and

1761 (re-search-forward (concat "\\b" attr "\\b") e t)

1762 (progn (skip-chars-forward " \t\n=")

1763 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1764 (YaTeX-match-string 1)))))

1765

1766 (defun yahtml-goto-corresponding-source (&optional other)

1767 "Goto applet's source."

1768 (let ((env (yahtml-current-tag)) s (p (point)))

1769 (cond

1770 ((string-match "applet" env)

1771 (if (setq s (yahtml-get-attrvalue "code"))

1772 (progn

1773 (setq s (YaTeX-match-string 1)

1774 s (concat

1775 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1776 ".java"))

1777 (if other (YaTeX-switch-to-buffer-other-window s)

1778 (YaTeX-switch-to-buffer s))

1779 s) ;return source file name

1780 (message "No applet source specified")

1781 (sit-for 1)

1782 nil))

1783 ((string-match "!--#include" env)

1784 (cond

1785 ((setq s (yahtml-get-attrvalue "file")) ;

1786 (if other (YaTeX-switch-to-buffer-other-window s)

1787 (YaTeX-switch-to-buffer s))

1788 s)

1789 ((setq s (yahtml-get-attrvalue "virtual"));

1790 (setq s (yahtml-url-to-path s))

1791 (if other (YaTeX-switch-to-buffer-other-window s)

1792 (YaTeX-switch-to-buffer s))

1793 s)))

1794 ((and (string-match "!--#exec" env)

1795 (setq s (yahtml-get-attrvalue "cmd")))

1796 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1797 (let ((b " *yahtmltmp*")) ;peek a little

1798 (unwind-protect

1799 (progn

1800 (set-buffer (get-buffer-create b))

1801 (YaTeX-insert-file-contents s nil 0 100)

1802 (if (looking-at "#!")

1803 (if other (YaTeX-switch-to-buffer-other-window s)

1804 (YaTeX-switch-to-buffer s))))

1805 (kill-buffer (get-buffer b)))

1806 (get-file-buffer s))))))

1807

1808 (defun yahtml-goto-corresponding-* (&optional other)

1809 "Go to corresponding object."

1810 (interactive)

1811 (cond

1812 ((yahtml-goto-corresponding-href other))

1813 ((yahtml-goto-corresponding-img))

1814 ((yahtml-goto-corresponding-begend))

1815 ((yahtml-goto-corresponding-source other))

1816 (t (message "I don't know where to go."))

1817 ))

1818

1819 (defun yahtml-goto-corresponding-*-other-window ()

1820 "Go to corresponding object."

1821 (interactive)

1822 (yahtml-goto-corresponding-* t))

1823

1824 (defun yahtml-visit-main ()

1825 "Go to parent file from where you visit current file."

1826 (interactive)

1827 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1828

1829 ;;; ---------- killing ----------

1830 (defun yahtml-kill-begend (&optional whole)

1831 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1832 (if tag

1833 (save-excursion

1834 (or (looking-at "<")

1835 (progn (skip-chars-backward "^<") (forward-char -1)))

1836 (setq p (point))

1837 (yahtml-goto-corresponding-begend)

1838 (or (looking-at "<")

1839 (progn (skip-chars-backward "^<") (forward-char -1)))

1840 (if (< (point) p) ;if on the opening tag

1841 (progn (setq q p p (point))

1842 (goto-char q))

1843 (setq q (point))) ;now q has end-line's (point)

1844 (if (not whole)

1845 (kill-region

1846 (progn (skip-chars-backward " \t")

1847 (if (setq bbolp (bolp)) (point) q))

1848 (progn (forward-list 1)

1849 (setq r (point))

1850 (skip-chars-forward " \t")

1851 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1852 (goto-char p)

1853 (skip-chars-backward " \t")

1854 (if (not whole)

1855 (progn

1856 (kill-append

1857 (buffer-substring

1858 (setq p (if (setq bbolp (bolp)) (point) p))

1859 (setq q (progn

1860 (forward-list 1)

1861 (setq r (point))

1862 (skip-chars-forward " \t")

1863 (if (and bbolp (eolp) (not (eobp)))

1864 (1+ (point))

1865 r))))

1866 t)

1867 (delete-region p q))

1868 (kill-region

1869 (if (bolp) (point) p)

1870 (progn (goto-char q)

1871 (forward-list 1)

1872 (setq r (point))

1873 (skip-chars-forward " \t")

1874 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1875 tag))))

1876

1877 (defun yahtml-kill-* (whole)

1878 "Kill current position's HTML tag (set)."

1879 (interactive "P")

1880 (cond

1881 ((yahtml-kill-begend whole))

1882 ))

1883

1884

1885 ;;; ---------- changing ----------

1886 (defun yahtml-on-assignment-p ()

1887 "Return if current point is on parameter assignment.

1888 If so, return parameter name, otherwise nil.

1889 This function should be able to treat white spaces in value, but not yet."

1890 (let ((p (point)))

1891 (save-excursion

1892 (put 'yahtml-on-assignment-p 'region nil)

1893 (skip-chars-backward "^ \t\n")

1894 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

1895 (< p (match-end 0))

1896 (>= p (1- (match-beginning 2)))

1897 (put 'yahtml-on-assignment-p 'region

1898 (cons (match-beginning 2) (match-end 2)))

1899 (YaTeX-match-string 1)))))

1900

1901 (defun yahtml-change-begend ()

1902 (let ((tag (yahtml-on-begend-p))

1903 (completion-ignore-case t)

1904 (case-fold-search t)

1905 (p (point)) (q (make-marker))

1906 (default (append yahtml-env-table yahtml-typeface-table))

1907 (user (append yahtml-user-env-table yahtml-user-typeface-table))

1908 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

1909 href b1 e1 attr new css)

1910 (cond

1911 (tag

1912 (cond

1913 ((and (string-match "^a$" tag)

1914 (save-excursion

1915 (and

1916 (re-search-backward "<a\\b" nil t)

1917 (progn

1918 (goto-char (match-end 0))

1919 (skip-chars-forward " \t\n")

1920 (setq b1 (point))

1921 (search-forward ">" nil t))

1922 (setq e1 (match-beginning 0))

1923 (goto-char b1)

1924 (re-search-forward "href\\s *=" e1 t)

1925 (>= p (point))

1926 (progn

1927 (goto-char (match-end 0))

1928 (skip-chars-forward " \t\n")

1929 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

1930 (< p (match-end 0)))))

1931 (setq b1 (match-beginning 1) e1 (match-end 1)

1932 yahtml-completing-buffer (current-buffer)

1933 ;; yahtml-urls-local is buffer-local, so we must put

1934 ;; that into yahtml-urls here

1935 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

1936 href (read-from-minibuffer

1937 "Change href to: " "" yahtml-url-completion-map))

1938 (if (string< "" href)

1939 (progn

1940 ;;(setq href ;??

1941 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

1942 (delete-region b1 e1)

1943 (goto-char b1)

1944 (insert href))))

1945 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

1946 (if (and (equal attr "class") ;treat "class" attribute specially

1947 (setq css (yahtml-css-get-element-completion-alist tag)))

1948 (setq new (yahtml-read-parameter ;should be made generic?

1949 attr nil (list (cons "class" css))))

1950 ;;other than "class", read parameter normally

1951 (setq new (yahtml-read-parameter attr)))

1952 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

1953 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

1954 (insert new))

1955 (t

1956 (save-excursion

1957 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

1958 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

1959 (skip-chars-forward "^A-Za-z")

1960 (set-marker q (point))

1961 (setq p (point))

1962 (yahtml-goto-corresponding-begend)

1963 (or (= (char-after (point)) ?<)

1964 (skip-chars-backward "^<"))

1965 (skip-chars-forward "^A-Za-z")

1966 (if (= (char-after (1- (point))) ?/)

1967 (progn

1968 (set-marker q (point))

1969 (goto-char p)))

1970 (setq tag (let ((completion-ignore-case t))

1971 (YaTeX-cplread-with-learning

1972 (format "Change `%s' to(default %s): "

1973 tag yahtml-last-begend)

1974 'default 'user 'tmp)))

1975 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1976 (if (string= "" tag) (setq tag yahtml-last-begend))

1977 (setq yahtml-last-begend

1978 (or (cdr (assoc tag yahtml-env-table)) tag)

1979 tag yahtml-last-begend)

1980 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

1981 (insert (format "%s%s" tag (yahtml-addin tag)))

1982 (goto-char q)

1983 (set-marker q nil)

1984 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1985 (insert tag))))

1986 t))))

1987

1988 (defun yahtml-change-command ()

1989 (let ((p (point)) (case-fold-search t) cmd par new

1990 (beg (make-marker)) (end (make-marker)))

1991 (skip-chars-backward "^<")

1992 (if (and

1993 (looking-at yahtml-command-regexp)

1994 (progn

1995 (set-marker beg (match-beginning 0))

1996 (set-marker end (match-end 0))

1997 t) ;for further work

1998 (progn

1999 (forward-char -1)

2000 (condition-case nil

2001 (forward-list 1)

2002 (error nil))

2003 (< p (point))))

2004 (progn

2005 (goto-char p)

2006 (if (setq par (yahtml-on-assignment-p))

2007 (progn

2008 (setq new (yahtml-read-parameter par))

2009 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2010 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2011 (setq new

2012 (YaTeX-cplread-with-learning

2013 "Change form to: "

2014 'yahtml-form-table 'yahtml-user-form-table

2015 'yahtml-tmp-form-table)))

2016 (delete-region beg end)

2017 (goto-char beg)

2018 (set-marker beg nil)

2019 (set-marker end nil)

2020 (insert new)

2021 t)

2022 (goto-char p)

2023 nil)))

2024

2025 (defun yahtml-change-* ()

2026 "Change current position's HTML tag (set)."

2027 (interactive)

2028 (cond

2029 ((yahtml-change-begend))

2030 ((yahtml-change-command))

2031 ))

2032

2033 ;;; ---------- commenting ----------

2034

2035 (defun yahtml-comment-region (&optional uncom)

2036 "Comment out region or environment."

2037 (interactive)

2038 (let ((e (make-marker)) be beg p)

2039 (cond

2040 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2041 (setq be (yahtml-on-begend-p))

2042 (save-excursion

2043 (setq p (point))

2044 (if (string-match "^/" be)

2045 (setq beg (progn (forward-line 1) (point)))

2046 (setq beg (progn (beginning-of-line) (point))))

2047 (goto-char p)

2048 (yahtml-goto-corresponding-begend)

2049 (if (string-match "^/" be)

2050 (beginning-of-line)

2051 (forward-line 1))

2052 (set-marker e (point))

2053 ;(comment-region beg (point) (if uncom (list 4)))

2054 ))

2055 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2056 (setq beg (region-beginning))

2057 (set-marker e (region-end))))

2058 (if yahtml-translate-hyphens-when-comment-region

2059 (let ((yahtml-entity-reference-chars-alist-default nil)

2060 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2061 yahtml-entity-reference-chars-regexp

2062 yahtml-entity-reference-chars-reverse-regexp)

2063 (yahtml-entity-reference-chars-setup)

2064 (funcall

2065 (if uncom 'yahtml-translate-reverse-region

2066 'yahtml-translate-region)

2067 beg e)))

2068 (comment-region beg e (if uncom (list 4)))

2069 (set-marker e nil)))

2070

2071 (defun yahtml-uncomment-region ()

2072 (interactive)

2073 (yahtml-comment-region t))

2074

2075 ;;; ---------- translate to entity references ----------

2076 (defvar yahtml-entity-reference-chars-alist-default

2077 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2078 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2079 "Default translation table from character to entity reference")

2080 (defvar yahtml-entity-reference-chars-alist nil

2081 "*Translation table from character to entity reference")

2082 (defvar yahtml-entity-reference-chars-regexp nil)

2083 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2084

2085 (defun yahtml-entity-reference-chars-setup ()

2086 (let ((list (append yahtml-entity-reference-chars-alist-default

2087 yahtml-entity-reference-chars-alist)))

2088 (setq yahtml-entity-reference-chars-regexp "["

2089 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2090 (while list

2091 (setq yahtml-entity-reference-chars-regexp

2092 (concat yahtml-entity-reference-chars-regexp

2093 (char-to-string (car (car list))))

2094 yahtml-entity-reference-chars-reverse-regexp

2095 (concat yahtml-entity-reference-chars-reverse-regexp

2096 (cdr (car list))

2097 (if (cdr list) "\\|")))

2098 (setq list (cdr list)))

2099 (setq yahtml-entity-reference-chars-regexp

2100 (concat yahtml-entity-reference-chars-regexp "]")

2101 yahtml-entity-reference-chars-reverse-regexp

2102 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2103

2104 (yahtml-entity-reference-chars-setup)

2105

2106 (defun yahtml-translate-region (beg end)

2107 "Translate inhibited literals."

2108 (interactive "r")

2109 (save-excursion

2110 (save-restriction

2111 (narrow-to-region beg end)

2112 (let ((ct (append yahtml-entity-reference-chars-alist

2113 yahtml-entity-reference-chars-alist-default)))

2114 (goto-char beg)

2115 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2116 ;(setq c (preceding-char))

2117 (replace-match

2118 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2119

2120 (defun yahtml-translate-reverse-region (beg end)

2121 "Translate entity references to literals."

2122 (interactive "r")

2123 (save-excursion

2124 (save-restriction

2125 (narrow-to-region beg end)

2126 (let ((ct (append yahtml-entity-reference-chars-alist

2127 yahtml-entity-reference-chars-alist-default))

2128 ec)

2129 (goto-char beg)

2130 (while (re-search-forward

2131 yahtml-entity-reference-chars-reverse-regexp nil t)

2132 ;(setq c (preceding-char))

2133 (setq ec (YaTeX-match-string 1))

2134 (delete-region (match-end 0) (match-beginning 0))

2135 (insert (car (YaTeX-rassoc ec ct))))))))

2136

2137 (defun yahtml-inner-environment-but (exclude &optional quick)

2138 "Return the inner environment but matches with EXCLUDE tag."

2139 (let (e (case-fold-search t))

2140 (save-excursion

2141 (while (and (setq e (YaTeX-inner-environment quick))

2142 (string-match exclude e))

2143 (goto-char (get 'YaTeX-inner-environment 'point))))

2144 e))

2145

2146 ;;; ---------- filling ----------

2147 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2148 (defun yahtml-move-to-column (col &optional force)

2149 (beginning-of-line)

2150 (let ((ccol 0))

2151 (while (and (> col ccol) (not (eolp)))

2152 (if (eq (following-char) ?\<)

2153 (progn

2154 (while (and (not (eq (following-char) ?\>))

2155 (not (eolp)))

2156 (forward-char))

2157 (or (eolp) (forward-char)))

2158 (or (eolp) (forward-char))

2159 (if (eq (preceding-char) ?\t)

2160 (let ((wd (- 8 (% (+ ccol 8) 8))))

2161 (if (and force (< col (+ ccol wd)))

2162 (progn

2163 (backward-char 1)

2164 (insert-char ?\ (- col ccol))

2165 (setq ccol col))

2166 (setq ccol (+ ccol wd))))

2167 (setq ccol (1+ ccol)))

2168 (if (and YaTeX-japan

2169 (or

2170 (and (fboundp 'char-category)

2171 (string-match "[chj]" (char-category (preceding-char))))

2172 (and (fboundp 'char-charset)

2173 (not (eq (char-charset (preceding-char)) 'ascii)))))

2174 (setq ccol (1+ ccol)))))

2175 (if (and force (> col ccol))

2176 (progn

2177 (insert-char ?\ (- col ccol))

2178 col)

2179 ccol)))

2180

2181 (defun yahtml-fill-paragraph (arg)

2182 (interactive "P")

2183 (let*((case-fold-search t) (p (point)) fill-prefix

2184 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2185 indent

2186 (startp (get 'YaTeX-inner-environment 'point))

2187 (prep (string-match "^pre$" e))

2188 (ps1 (if prep (default-value 'paragraph-start)

2189 paragraph-start))

2190 (ps2 (if prep (concat (default-value 'paragraph-start)

2191 "$\\|^\\s *</?pre>")

2192 paragraph-start)))

2193 (save-excursion

2194 (unwind-protect

2195 (progn

2196 (if prep

2197 (fset 'move-to-column 'yahtml-move-to-column))

2198 (save-excursion

2199 (beginning-of-line)

2200 (indent-to-column (yahtml-this-indent))

2201 (setq fill-prefix

2202 (buffer-substring (point) (point-beginning-of-line)))

2203 (delete-region (point) (point-beginning-of-line)))

2204 (fill-region-as-paragraph

2205 (progn (re-search-backward paragraph-start nil t)

2206 (or (save-excursion

2207 (goto-char (match-beginning 0))

2208 (if (looking-at "<")

2209 (forward-list)

2210 (goto-char (match-end 0))

2211 (skip-chars-forward " \t>"))

2212 (if (looking-at "[ \t]*$")

2213 (progn (forward-line 1) (point))))

2214 (point)))

2215 (progn (goto-char p)

2216 (re-search-forward ps2 nil t)

2217 (match-beginning 0))))

2218 (fset 'move-to-column yahtml-saved-move-to-column)))))

2219

2220 ;(defun yahtml-indent-new-commnet-line ()

2221 ; (unwind-protect

2222 ; (progn

2223 ; (fset 'move-to-column 'yahtml-move-to-column)

2224 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2225 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2226

2227 ;;;

2228 ;;; ---------- indentation ----------

2229 ;;;

2230 (defun yahtml-indent-line ()

2231 "Indent a line (faster wrapper)"

2232 (interactive)

2233 (let (indent)

2234 (if (and (save-excursion

2235 (beginning-of-line) (skip-chars-forward "\t ")

2236 (not (looking-at "<")))

2237 (save-excursion

2238 (forward-line -1)

2239 (while (and (not (bobp)) (looking-at "^\\s *$"))

2240 (forward-line -1))

2241 (skip-chars-forward "\t ")

2242 (setq indent (current-column))

2243 (not (looking-at "<"))))

2244 (progn

2245 (save-excursion

2246 (beginning-of-line)

2247 (skip-chars-forward " \t")

2248 (or (= (current-column) indent)

2249 (YaTeX-reindent indent)))

2250 (and (bolp) (skip-chars-forward " \t")))

2251 (yahtml-indent-line-real))))

2252

2253 (defun yahtml-this-indent ()

2255 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2256 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2257 (excludes

2258 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2259 inenv p col peol (case-fold-search t))

2260 (save-excursion

2261 (beginning-of-line)

2262 (setq inenv (or (yahtml-inner-environment-but excludes t)

2263 "html")

2264 col (get 'YaTeX-inner-environment 'indent)

2265 p (get 'YaTeX-inner-environment 'point)

2266 op nil))

2267 (save-excursion

2268 (cond

2269 ((string-match (concat "^\$" envs "\$") inenv)

2270 (save-excursion

2271 (beginning-of-line)

2272 (skip-chars-forward " \t")

2273 (cond ;lookup current line's tag

2274 ((looking-at (concat "</\$" envs "\$>"))

2275 col)

2276 ((looking-at itms)

2277 (+ col yahtml-environment-indent))

2278 ((and yahtml-hate-too-deep-indentation

2279 (looking-at (concat "<\$" envs "\$")))

2280 (+ col (* 2 yahtml-environment-indent)))

2281 ((and (< p (point))

2282 (string-match itemizing-envs inenv)

2283 (save-excursion

2284 (and

2285 (setq op (point))

2286 (goto-char p)

2287 (re-search-forward itms op t)

2288 (progn

2289 (if yahtml-indent-listing-constant

2290 (setq col (+ (current-column)

2291 (if yahtml-faithful-to-htmllint 1 2)))

2292 (skip-chars-forward "^>")

2293 (skip-chars-forward ">")

2294 (skip-chars-forward " \t")

2295 (setq col (if (looking-at "$")

2296 (+ col yahtml-environment-indent)

2297 (current-column))))))))

2298 col)

2299 (t

2300 (+ col yahtml-environment-indent)))))

2301 (t col)))))

2302

2303 (defun yahtml-indent-line-real ()

2304 "Indent current line."

2305 (interactive)

2306 (YaTeX-reindent (yahtml-this-indent))

2307 (if (bolp) (skip-chars-forward " \t"))

2308 (let (peol col inenv)

2309 (if (and (setq inenv (yahtml-on-begend-p))

2310 (string-match

2311 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2312 (save-excursion

2313 (setq peol (point-end-of-line))

2314 (or (= (char-after (point)) ?<)

2315 (progn (skip-chars-backward "^<") (forward-char -1)))

2316 (setq col (current-column))

2317 (if (and (yahtml-goto-corresponding-begend t)

2318 (> (point) peol)) ;if on the different line

2319 (YaTeX-reindent col))))))

2320

2321 ;(defun yahtml-fill-item ()

2322 ; "Fill item HTML version"

2323 ; (interactive)

2324 ; (let (inenv p fill-prefix peol (case-fold-search t))

2325 ; (setq inenv (or (YaTeX-inner-environment) "html")

2326 ; p (get 'YaTeX-inner-environment 'point))

2327 ; (cond

2328 ; ((string-match "^[uod]l" inenv)

2329 ; (save-excursion

2330 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2331 ; (progn

2332 ; (goto-char (match-end 0))

2333 ; (setq col (current-column)))

2334 ; (error "No <li>, <dt>, <dd>")))

2335 ; (save-excursion

2336 ; (end-of-line)

2337 ; (setq peol (point))

2338 ; (newline)

2339 ; (indent-to-column col)

2340 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2341 ; (delete-region (point) peol)

2342 ; (fill-region-as-paragraph

2343 ; (progn (re-search-backward paragraph-start nil t) (point))

2344 ; (progn (re-search-forward paragraph-start nil t 2)

2345 ; (match-beginning 0)))))

2346 ; (t nil))))

2347

2348 ;;;

2349 ;;; ---------- Lint and Browsing ----------

2350 ;;;

2351 (defun yahtml-browse-menu ()

2352 "Browsing menu"

2353 (interactive)

2354 (message "J)weblint p)Browse R)eload...")

2355 (let ((c (char-to-string (read-char))))

2356 (cond

2357 ((string-match "j" c)

2358 (yahtml-lint-buffer (current-buffer)))

2359 ((string-match "[bp]" c)

2360 (yahtml-browse-current-file))

2361 ((string-match "r" c)

2362 (yahtml-browse-reload)))))

2363

2364 (if (fboundp 'wrap-function-to-control-ime)

2365 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2366

2367 (defvar yahtml-lint-buffer "*weblint*")

2368

2369 (defun yahtml-lint-buffer (buf)

2370 "Call lint on buffer BUF."

2371 (require 'yatexprc)

2372 (interactive "bCall lint on buffer: ")

2373 (setq buf (get-buffer buf))

2374 (YaTeX-save-buffers)

2375 (YaTeX-typeset

2376 (concat yahtml-lint-program " "

2377 (file-name-nondirectory (buffer-file-name buf)))

2378 yahtml-lint-buffer "lint" "lint"))

2379

2380 (defun yahtml-file-to-url (file)

2381 "Convert local unix file name to URL.

2382 If no matches found in yahtml-path-url-alist, return raw file name."

2383 (let ((list yahtml-path-url-alist) p url)

2384 (if (file-directory-p file)

2385 (setq file (expand-file-name yahtml-directory-index file))

2386 (setq file (expand-file-name file)))

2387 (if (string-match "^[A-Za-z]:/" file)

2388 (progn

2389 ;; (aset file 1 ?|) ;これは要らないらしい…

2390 (setq file (concat "///" file))))

2391 (while list

2392 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2393 (setq url (cdr (car list))

2394 file (substring file (match-end 0))

2395 url (concat url file)

2396 list nil))

2397 (setq list (cdr list)))

2398 (or url (concat "file:" file))))

2399

2400 (defun yahtml-url-to-path (file &optional basedir)

2401 "Convert local URL name to unix file name."

2402 (let ((list yahtml-path-url-alist) url realpath docroot

2403 (dirsufp (string-match "/$" file)))

2404 (setq basedir (or basedir

2405 (file-name-directory

2406 (expand-file-name default-directory))))

2407 (cond

2408 ((string-match "^/" file)

2409 (while list

2410 (if (file-directory-p (car (car list)))

2411 (progn

2412 (setq url (cdr (car list)))

2413 (if (string-match "\$http://[^/]*\$/" url)

2414 (setq docroot (substring url (match-end 1)))

2415 (setq docroot url))

2416 (cond

2417 ((string-match (concat "^" (regexp-quote docroot)) file)

2418 (setq realpath

2419 (expand-file-name

2420 (substring

2421 file

2422 (if (= (aref file (1- (match-end 0))) ?/)

2423 (match-end 0) ; "/foo"

2424 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2425 (car (car list))))))

2426 (if realpath

2427 (progn (setq list nil)

2428 (if (and dirsufp (not (string-match "/$" realpath)))

2429 (setq realpath (concat realpath "/")))))))

2430 (setq list (cdr list)))

2431 realpath)

2432 (t file))))

2433

2434 (defun yahtml-browse-current-file ()

2435 "Call WWW browser on current file."

2436 (interactive)

2437 (basic-save-buffer)

2438 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2439

2440 (defun yahtml-browse-reload ()

2441 "Send `reload' event to netzscape."

2442 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2443 (cond

2444 ((string-match "[Nn]etscape" yahtml-www-browser)

2445 (if (get-buffer pb)

2446 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2447 ;;(or (get 'yahtml-netscape-sentinel 'url)

2448 ;; (error "Reload should be called after Browsing."))

2449 (put 'yahtml-netscape-sentinel 'url

2450 (yahtml-file-to-url (buffer-file-name)))

2451 (basic-save-buffer)

2452 (set-process-sentinel

2453 (setq yahtml-browser-process

2454 (start-process

2455 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2456 (format "%s -remote 'reload'" yahtml-www-browser)))

2457 'yahtml-netscape-sentinel))

2458 (t

2459 (message "Sorry, RELOAD is supported only for Netscape.")))))

2460

2461 ;;; ---------- Intelligent newline ----------

2462 (defun yahtml-intelligent-newline (arg)

2463 "Intelligent newline for HTML"

2464 (interactive "P")

2465 (let (env func)

2466 (end-of-line)

2467 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2468 "html")))

2469 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2470 (newline)

2471 (if (and env func (fboundp func))

2472 ;; if intelligent line function is defined, call that

2473 (funcall func)

2474 ;; else do the default action

2475 (if (string-match yahtml-p-prefered-env-regexp env)

2476 (yahtml-insert-p)))))

2477

2478 (defun yahtml-intelligent-newline-ul ()

2479 (interactive)

2480 (yahtml-insert-single "li")

2481 (or yahtml-faithful-to-htmllint (insert " "))

2482 (yahtml-indent-line))

2483

2484 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2485

2486 (defun yahtml-intelligent-newline-dl ()

2487 (interactive)

2488 (let ((case-fold-search t))

2489 (if (save-excursion

2490 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2491 (get 'YaTeX-inner-environment 'point) t))

2492 (cond

2493 ((match-beginning 2)

2494 (yahtml-insert-single "dd")

2495 (or yahtml-faithful-to-htmllint (insert " "))

2496 (setq yahtml-last-single-cmd "dt"))

2497 ((match-beginning 3)

2498 (yahtml-insert-single "dt")

2499 (or yahtml-faithful-to-htmllint (insert " "))

2500 (setq yahtml-last-single-cmd "dd")))

2501 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

2502 (setq yahtml-last-single-cmd "dd"))

2503 (yahtml-indent-line)

2504 (and (string-match yahtml-p-prefered-env-regexp "dl")

2505 (string-equal yahtml-last-single-cmd "dt")

2506 (yahtml-insert-p nil))))

2507

2508 (defun yahtml-intelligent-newline-select ()

2509 (interactive)

2510 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2511 (yahtml-indent-line))

2512

2513 (defun yahtml-intelligent-newline-style ()

2514 (interactive)

2515 (if (save-excursion

2516 (and

2517 (re-search-backward "<style\\|<!-- " nil t)

2518 (looking-at "<style")))

2519 (let (c)

2520 (yahtml-indent-line)

2521 (setq c (current-column))

2522 (insert "<!--\n")

2523 (YaTeX-reindent c)

2524 (insert "-->")

2525 (beginning-of-line)

2526 (open-line 1)

2527 (YaTeX-reindent c))))

2528

2529 ;;; ---------- Marking ----------

2530 (defun yahtml-mark-begend ()

2531 "Mark current tag"

2532 (interactive)

2533 (YaTeX-beginning-of-environment)

2534 (let ((p (point)))

2535 (save-excursion

2536 (skip-chars-backward " \t" (point-beginning-of-line))

2537 (if (bolp) (setq p (point))))

2538 (push-mark p t))

2539 (yahtml-goto-corresponding-begend)

2540 (forward-list 1)

2541 (if (eolp) (forward-char 1)))

2542

2543 ;;; ---------- complete marks ----------

2544 (defun yahtml-complete-mark ()

2545 "Complete &gt, &lt, &ampersand, and &quote."

2546 (interactive)

2547 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2548 (let ((c (read-char)))

2549 (setq c (if (or (< c ?0) (> c ?7))

2550 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2551 (- c ?1)))

2552 (if (or (< c 0) (> c 6))

2553 nil

2554 (insert (format "&%s;"

2555 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2556

2557

2558 ;;; ---------- jump to error line ----------

2559 (defun yahtml-prev-error ()

2560 "Jump to previous error seeing lint buffer."

2561 (interactive)

2562 (or (get-buffer yahtml-lint-buffer)

2563 (error "No lint program ran."))

2564 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2565 (yahtml-jump-to-error-line t))

2566

2567 (defun yahtml-jump-to-error-line (&optional sit)

2568 (interactive "P")

2569 (let ((p (point)) (e (point-end-of-line)))

2570 (end-of-line)

2571 (if (re-search-backward yahtml-error-line-regexp nil t)

2572 (let ((f (if (string= "" (YaTeX-match-string 1))

2573 YaTeX-current-file-name

2574 (YaTeX-match-string 1)))

2575 (l (string-to-int (or (YaTeX-match-string 2)

2576 (YaTeX-match-string 3)))))

2577 (if sit (sit-for 1))

2578 (forward-line -1)

2579 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2580 (goto-line l))

2581 (message "No line number usage"))))

2582

2583 ;;; ---------- Style Sheet Support ----------

2584 (defvar yahtml-css-class-alist nil

2585 "Alist of elements vs. their classes")

2586

2587 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2588 (save-excursion

2589 (save-restriction

2590 (narrow-to-region beg end)

2591 (goto-char (point-min))

2592 (let ((alist initial) b e element class a)

2593 (setq b (point))

2594 (while (search-forward "{" nil t)

2595 (setq e (point))

2596 (goto-char b)

2597 (while (re-search-forward ;ちょといい加減なREGEXP

2598 "\$[a-z][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>" e t)

2599 (setq element (YaTeX-match-string 1)

2600 class (YaTeX-match-string 2))

2601 ;;if starts with period (match-string 1 is nil),

2602 ;;this is global class

2603 (setq element (downcase (or element "global")))

2604 (if (setq a (assoc element alist))

2605 (or (assoc class (cdr a))

2606 (setcdr a (cons (list class) (cdr a))))

2607 (setq alist (cons (list element (list class)) alist))))

2608 (goto-char (1- e))

2609 (search-forward "}" nil t)

2610 (setq b (point)))

2611 alist))))

2612

2613 (defun yahtml-css-collect-classes-buffer (&optional initial)

2614 (interactive)

2615 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2616

2617 (defun yahtml-css-collect-classes-file (file &optional initial)

2618 (let*((hilit-auto-highlight nil)

2619 (openedp (get-file-buffer file))

2620 (cb (current-buffer))

2621 (buf (set-buffer (find-file-noselect file))))

2622 (prog1

2623 (yahtml-css-collect-classes-buffer initial)

2624 (or openedp (kill-buffer buf))

2625 (set-buffer cb))))

2626

2627 (defun yahtml-css-scan-styles ()

2628 (save-excursion

2629 (goto-char (point-min))

2630 (set (make-local-variable 'yahtml-css-class-alist) nil)

2631 (let (b tag type e href alist)

2632 (while (re-search-forward "<\$style\\|link\$" nil t)

2633 (setq b (match-beginning 0)

2634 tag (YaTeX-match-string 1))

2635 (cond

2636 ((string-match "style" tag)

2637 (goto-char b)

2638 (save-excursion (forward-list 1) (setq e (point)))

2639 (cond

2640 ((search-forward "text/css" e 1) ;css definition starts

2641 (setq alist

2642 (yahtml-css-collect-classes-region

2643 (point) (progn (search-forward "</style>") (point))

2644 alist)))))

2645 ((and (string-match "link" tag)

2646 (stringp (setq type (yahtml-get-attrvalue "type")))

2647 (string-match "text/css" type)

2648 (setq href (yahtml-get-attrvalue "href"))

2649 (file-exists-p (yahtml-url-to-path href)))

2650 (setq alist

2651 (yahtml-css-collect-classes-file

2652 (yahtml-url-to-path href) alist))))

2653 (setq yahtml-css-class-alist alist)))))

2654

2655 (defun yahtml-css-get-element-completion-alist (element)

2656 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

2657 (global (cdr-safe (assoc "global" yahtml-css-class-alist))))

2658 (and (or alist global)

2659 (append alist global))))

2660

2661 ;;; ---------- ----------

2662

2663 ;;;

2664 ;;hilit19

2665 ;;;

2666 (defvar yahtml-default-face-table

2667 '(

2668 (form black/ivory white/hex-442233 italic)

2669 ))

2670 (defvar yahtml-hilit-patterns-alist

2671 '(

2672 'case-fold

2673 ;; comments

2674 ("" comment)

2675 ;; include&exec

2676 ("" include)

2677 ;; string

2678 (hilit-string-find ?\\ string)

2679 (yahtml-hilit-region-tag "<\$em\\|strong\\|b\$\\>" bold)

2680 ("</?[uod]l>" 0 decl)

2681 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2682 (yahtml-hilit-region-tag "<\$i\\>\$" italic)

2683 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

2684 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

2685 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2686 ))

2687

2688 (defun yahtml-hilit-region-tag (tag)

2689 "Return list of start/end point of <TAG> form."

2690 (if (re-search-forward tag nil t)

2691 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

2692 (elm (YaTeX-match-string 1)))

2693 (skip-chars-forward "^>")

2694 (prog1

2695 (cons (1+ (point))

2696 (progn (re-search-forward (concat "</" elm ">") nil t)

2697 (match-beginning 0)))

2698 (goto-char e0)))))

2699

2700 (defun yahtml-hilit-region-tag-itself (ptn)

2701 "Return list of start/end point of <tag options...> itself."

2702 (if (re-search-forward ptn nil t)

2703 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

2704 (skip-chars-forward "^<>")

2705 (if (eq (char-after (point)) ?<) nil

2706 (prog1

2707 (cons m0 (min (point-max) (1+ (point))))

2708 (goto-char e0))))))

2709

2710 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2711 (and yahtml-use-hilit19

2712 (or (assq 'yahtml-mode hilit-patterns-alist)

2713 (setq hilit-patterns-alist

2714 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2715 hilit-patterns-alist))))

2716 ;;;

2717 ;; for font-lock

2718 ;;;

2719

2720 ; <<STATIC KEYWORDS BELOW NOT USED>>

2721 ;(defvar yahtml-font-lock-keywords

2722 ; '(

2723 ; ;; comments

2724 ; ("" . font-lock-comment-face)

2725 ; ;; include&exec

2726 ; (""

2727 ; 0 font-lock-include-face keep)

2728 ; ;; string

2729 ; ;(hilit-string-find ?\\ string)

2730 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2731 ; ("</?[uod]l>" 0 font-lock-keyword-face)

2732 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

2733 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

2734 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2735 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

2736 ; )

2737 ; "*Defualt font-lock-keywords for yahtml-mode.")

2738 (defvar yahtml-font-lock-keywords

2739 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

2740 "Default fontifying patterns for yahtml-mode")

2741

2742 (defun yahtml-font-lock-set-default-keywords ()

2743 (put 'yahtml-mode 'font-lock-defaults

2744 '(yahtml-font-lock-keywords nil t)))

2745

2746 (if yahtml-use-font-lock

2747 (progn

2748 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

2749 ;;for those who use both hilit19 and font-lock

2750 (if (eq (car hilit-mode-enable-list) 'not)

2751 (or (member 'yahtml-mode hilit-mode-enable-list)

2752 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

2753 (setq hilit-mode-enable-list

2754 (delq 'yahtml-mode hilit-mode-enable-list))))

2755 (yahtml-font-lock-set-default-keywords)))

2756

2757 (defun yahtml-font-lock-recenter (&optional arg)

2758 (interactive "P")

2759 (font-lock-mode -1) ;is stupid, but sure.

2760 (font-lock-mode 1))

2761

2762 ;; (defun yahtml-fontify-to-tagend (lim)

2763 ;; "*Fontify any tag including < and >.

2764 ;; This is invalid use of font-lock function. Therefore

2765 ;; this fontifying will loose effectiveness soon or later."

2766 ;; (let ((start (match-beginning 0))

2767 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))

2768 ;; (or nil; (font-lock-any-faces-p start end)

2769 ;; (font-lock-fillin-text-property

2770 ;; start end 'face 'font-lock font-lock-keyword-face)))

2771 ;; nil)

2772

2773 (run-hooks 'yahtml-load-hook)

2774 (provide 'yahtml)

2775

2776 ; Local variables:

2777 ; fill-prefix: ";;; "

2778 ; paragraph-start: "^$\\|\\|;;;$"

2779 ; paragraph-separate: "^$\\|\\|;;;$"

2780 ; buffer-file-coding-system: sjis

2781 ; End: