yatex: f41b01fef5d6 yahtml.el

yatex

view yahtml.el @ 73:f41b01fef5d6

Stable version(hope to be)

author	yuuji
date	Wed, 22 May 2002 04:57:42 +0000
parents	0aaebd07dad0
children	1b172d26b55e

line source

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

2 ;;; (c ) 1994-2002 by HIROSE Yuuji [yuuji@yatex.org]

3 ;;; Last modified Wed May 22 13:55:01 2002 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 ;;;[Commentary]

41 ;;;

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

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

44 ;;;

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

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

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

48 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

73 ;;; change the reference link with completion.

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

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

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

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

78 ;;; is "netscape")

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

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

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

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

83 ;;; in the region.

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

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

86 ;;; URLencoded string in the region.

87 ;;;

88 ;;;[キーの説明]

89 ;;;

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

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

92 ;;;

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

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

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

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

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

98 ;;; できます。

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

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

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

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

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

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

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

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

107 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

119 ;;; す。

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

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

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

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

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

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

126 ;;; きます。

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

128 ;;; す。

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

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

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

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

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

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

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

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

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

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

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

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

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

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

143 ;;;

144 ;;; [謝辞]

145 ;;;

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

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

148 ;;;

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

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

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

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

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

154 ;;;

155

156

157 ;(require 'yatex)

158 (require 'yatexlib)

159 ;;; --- customizable variable starts here ---

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

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

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

163 (defvar yahtml-www-browser "netscape"

164 "*WWW Browser command")

165 (defvar yahtml-kanji-code 2

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

167 ;;(defvar yahtml-coding-system

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

169 ;; "Kanji coding system")

170 (and (featurep 'mule)

171 (integerp yahtml-kanji-code)

172 (setq yahtml-kanji-code

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

174

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

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

177

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

179 (defvar yahtml-path-url-alist nil

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

181 Ex.

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

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

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

185 "*Directory index file name;

186 Consult your site's WWW administrator.")

187

188 (defvar yahtml-environment-indent 1

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

190

191 (defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)

192 "Whether yatex mode is running on Japanese environment or not.")

193

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

195 "*Program name to lint HTML file")

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

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

198

199 (defvar yahtml-always-/p nil

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

201

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

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

204

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

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

207

208 (defvar yahtml-prefer-upcases nil

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

210

211 (defvar yahtml-prefer-upcase-attributes nil

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

213

214 (defvar yahtml-server-type 'apache

215 "*WWW server program type")

216

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

218 "*Server access file name for apache")

219

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

221

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

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

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

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

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

227 %f: filename")

228

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

230 (defvar yahtml-error-line-regexp

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

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

233

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

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

236 (defvar yahtml-escape-chars 'ask

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

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

239 at each reserved chars.")

240

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

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

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

244

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

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

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

248

249 (defvar yahtml-mode-abbrev-table nil

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

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

252

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

254 "*Boundary regexp for indentation calculation.")

255

256 ;;; --- customizable variable ends here ---

257 (defvar yahtml-prefix-map nil)

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

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

260 (defvar yahtml-shell-command-option

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

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

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

264

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

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

267 (YaTeX-define-key

268 key

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

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

271 map))

272

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

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

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

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

277

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

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

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

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

282 (if YaTeX-inhibit-prefix-letter nil

283 (yahtml-define-begend-region-key

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

285

286 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

298 (let ((map yahtml-prefix-map))

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

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

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

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

303 (and YaTeX-emacs-19 window-system

304 (progn

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

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

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

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

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

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

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

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

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

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

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

316 (if YaTeX-no-begend-shortcut

317 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

336 )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

351 )

352 (substitute-all-key-definition

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

354 (substitute-all-key-definition

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

356

357 (if yahtml-lint-buffer-map nil

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

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

360

361

362 (defvar yahtml-paragraph-start

363 (concat

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

365 "*Regexp of html paragraph separater")

366 (defvar yahtml-paragraph-separate

367 (concat

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

369 "*Regexp of html paragraph separater")

370 (defvar yahtml-syntax-table nil

371 "*Syntax table for yahtml-mode")

372

373 (if yahtml-syntax-table nil

374 (setq yahtml-syntax-table

375 (make-syntax-table (standard-syntax-table)))

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

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

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

379 )

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

381 "Regexp of constituent of html commands.")

382

383 ;;; Completion tables for `form'

384 (defvar yahtml-form-table

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

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

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

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

389

390 (defvar yahtml-env-table

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

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

393 ("OrderedList" . "ol")

394 ("UnorderedList" . "ul")

395 ("DefinitionList" . "dl")

396 ("Preformatted" . "pre")

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

398 ("address")

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

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

401 ("style") ("div") ("object")

402 ))

403

404 ;(defvar yahtml-itemizing-regexp

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

406 ; "Regexp of itemizing forms")

407

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

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

410

411 ;;; Completion tables for typeface designator

412 (and yahtml-always-/p

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

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

415

416 (defvar yahtml-typeface-table

417 (append

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

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

420 ("sup") ("sub") ("span"))

421 yahtml-env-table)

422 "Default completion table of typeface designator")

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

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

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

426

427 (defvar yahtml-single-cmd-table

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

429 ("HorizontalLine" . "hr")

430 ("BreakLine" . "br")

431 ("Paragraph" . "p")

432 ("Item" . "li")

433 ("DefineTerm" . "dt")

434 ("Description" . "dd")

435 ("dd") ("dt") ("li")

436 )

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

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

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

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

441

442 (defvar yahtml-current-completion-type nil

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

444

445 ;(defvar yahtml-struct-name-regexp

447 (defvar yahtml-struct-name-regexp

448 (concat

449 "\\<\\("

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

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

452 "\\)\\b")

453 "Regexp of structure beginning.")

454

455 (defvar yahtml-closable-regexp

456 (concat

457 "\\<\\("

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

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

460 "\\)\\b")

461 "Regexp of any closable elemnts.")

462

463 (defvar yahtml-indent-listing-constant t

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

465 T for static indentation depth")

466

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

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

469

470

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

472 (cond

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

474 buffer-file-name)

475 (let ((dir default-directory)

476 charset af ext (ldir "")

477 line

478 (case-fold-search t)

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

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

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

482 (while (and dir

483 (not (string= dir ldir))

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

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

486 (if (file-exists-p af)

487 (save-excursion

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

489 (save-excursion

490 (goto-char (point-min))

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

492 (setq line (buffer-substring

493 (point-beginning-of-line)

494 (point-end-of-line))

495 dir nil)))

496 (kill-buffer (current-buffer))))

497 (if dir

498 (setq ldir dir

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

500 dir (file-name-directory dir))))

501 line

502 ))

503 (t nil))

504 )

505

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

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

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

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

510 line

511 charset)

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

513 (progn

514 (string-match ptn line)

515 (setq charset

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

517 (cond

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

519 (setq charset 2))

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

521 (setq charset 3))

522 ((string-match "shift_jis" charset)

523 (setq charset 1))

524 (t (setq charset nil)))

525 (setq dir "")))

526 (if (featurep 'mule)

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

528 charset))

529

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

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

532 x index-list)

533 ;;s/\\s *$//;

534 (if line

535 (progn

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

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

538 (while (string< "" line)

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

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

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

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

543 line ""))

544 )

545 (or (nreverse index-list)

546 (if (listp yahtml-directory-index)

547 yahtml-directory-index

548 (list yahtml-directory-index)))))))

549

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

551 (defun yahtml-mode ()

552 (interactive)

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

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

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

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

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

558 (cond

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

560 (setq buffer-file-coding-system

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

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

563 coding)))

564 ((featurep 'mule)

565 (set-file-coding-system coding))

566 ((boundp 'NEMACS)

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

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

569 (setq major-mode 'yahtml-mode

570 mode-name "yahtml"

571 YaTeX-current-file-name (file-name-nondirectory

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

573 local-abbrev-table yahtml-mode-abbrev-table)

574 (mapcar

575 (function (lambda (x)

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

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

578 (boundp (cdr x)))

579 (symbol-value (cdr x))

580 (cdr x)))))

581 '((YaTeX-ec . "")

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

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

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

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

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

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

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

589 (paragraph-start . yahtml-paragraph-start)

590 (paragraph-separate . yahtml-paragraph-separate)

591 (comment-start . "")

592 (comment-start-skip . comment-start)

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

594

595 (if yahtml-use-font-lock

596 (progn

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

598 (or (featurep 'xemacs)

599 (progn

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

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

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

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

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

605 (font-lock-fontify-buffer)

606 ))

607 ))

608 (set-syntax-table yahtml-syntax-table)

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

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

611 (yahtml-css-scan-styles)

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

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

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

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

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

617

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

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

620 font-lock-defaults)

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

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

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

624

625 (defun yahtml-version ()

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

627 (interactive)

628 (message

629 (concat "Yet Another HTML-mode "

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

631 " Revision "

632 yahtml-revision-number)))

633

634 (defun yahtml-quit ()

635 (interactive)

636 (and yahtml-mode-old-mode

637 (fboundp yahtml-mode-old-mode)

638 (funcall yahtml-mode-old-mode)))

639

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

641 (cond

642 ((featurep 'xemacs)

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

644 (set keymap nil)

645 (mapcar

646 (function

647 (lambda (bind)

648 (setq bind (cdr bind))

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

650 (setcar (cdr bind) 'progn))

651 (if (stringp (car (cdr bind)))

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

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

654 (symbol-value keymap))))))

655 bindlist)

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

657 (t

658 (mapcar

659 (function

660 (lambda (bind)

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

662 bindlist))))

663

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

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

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

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

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

669

670 ;;; Variables for mosaic url history

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

672 (defvar yahtml-urls-private nil)

673 (defvar yahtml-urls-local nil)

674

675 (cond

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

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

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

679 (YaTeX-define-menu

680 'yahtml-menu-map-sectioning

681 (nreverse

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

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

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

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

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

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

688 )))

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

690 (YaTeX-define-menu

691 'yahtml-menu-map-logical

692 (nreverse

693 '((em "Embolden" .

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

695 (dfn "Define a word" .

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

697 (cite "Citation" .

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

699 (code "Code" .

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

701 (kbd "Keyboard" .

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

703 (samp "Sample display" .

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

705 (strong "Strong" .

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

707 (VAR "Variable notation" .

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

709 )))

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

711 (YaTeX-define-menu

712 'yahtml-menu-map-typeface

713 (nreverse

714 '((b "Bold" .

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

716 (i "Italic" .

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

718 (tt "Typewriter" .

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

720 (u "Underlined" .

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

722 )))

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

724 (YaTeX-define-menu

725 'yahtml-menu-map-listing

726 (nreverse

727 '((ul "Unordered" .

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

729 (ol "Ordered" .

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

731 (dl "Definition" .

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

733 )))

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

735 (YaTeX-define-menu

736 'yahtml-menu-map-item

737 (nreverse

738 '((li "Simple item" .

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

740 (dt "Define term" .

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

742 (dd "Description of term" .

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

744 )))

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

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

747 (YaTeX-define-menu

748 'yahtml-menu-map

749 (nreverse

750 (list

751 (cons (list 'sect "Sectioning")

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

753 (cons (list 'list "Listing")

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

755 (cons (list 'item "Item")

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

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

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

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

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

761 )))

762 (if (featurep 'xemacs)

763 (add-hook 'yahtml-mode-hook

764 '(lambda ()

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

766 (progn

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

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

769 ))

770

771 ;;; ----------- Completion ----------

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

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

774 "Insert <cmd> ... </cmd>."

775 (interactive "P")

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

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

778 (cmd

779 (or env

780 (YaTeX-cplread-with-learning

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

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

783 (bolp (save-excursion

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

785 (cc (current-column)))

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

787 (setq yahtml-last-begend

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

789 yahtml-last-begend))

790 (setq cmd yahtml-last-begend)

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

792 (if region

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

794 ;; to enable continuous regioning by another environment

795 (let ((beg (region-beginning))

796 (end (region-end))

797 (addin (yahtml-addin cmd)))

798 (save-excursion

799 (goto-char end)

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

801 (goto-char beg)

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

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

804 (save-excursion

805 (insert "\n")

806 (indent-to-column cc)

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

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

809 (newline)

810 (yahtml-intelligent-newline nil))

811 (yahtml-indent-line))))

812

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

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

815 (interactive)

816 (yahtml-insert-begend t))

817

818

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

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

821 (interactive)

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

823 (or form

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

825 (setq form

826 (YaTeX-cplread-with-learning

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

828 'yahtml-form-table 'yahtml-user-form-table

829 'yahtml-tmp-form-table))))

830 (let ((p (point)) q)

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

832 (setq yahtml-last-form form)

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

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

835 ;;(indent-relative-maybe)

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

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

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

839

840 ;;; ---------- Add-in ----------

841 (defun yahtml-addin (form)

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

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

844 (concat

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

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

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

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

849 "class"

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

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

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

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

854 (string< "" s))

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

856 ""))))

857

858 (defvar yahtml-completing-buffer nil)

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

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

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

862 (let (list end)

863 (save-excursion

864 (set-buffer yahtml-completing-buffer)

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

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

867 (save-excursion

868 (goto-char (point-min))

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

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

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

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

873 (setq end (match-end 0))

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

875 (yahtml-on-assignment-p)

876 (progn

877 (goto-char end)

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

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

880 (setq list (cons

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

882 list))))

883 list)))

884 )

885

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

887 (if yahtml-url-completion-map nil

888 (setq yahtml-url-completion-map

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

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

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

892 )

893

894 (defun yahtml-complete-url ()

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

896 (interactive)

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

898 (lim (YaTeX-minibuffer-begin))

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

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

901 (cond

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

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

904 listfunc (list 'lambda nil

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

906 beg min))

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

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

909 (progn

910 (setq path (substring initial 0 beg))

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

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

913 (setq initial (substring initial beg))

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

915 cmpl (try-completion initial labels)

916 listfunc (list 'lambda ()

917 (list 'all-completions

918 initial (list 'quote labels)))

919 beg (+ min beg)))

920 (t

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

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

923 initial))

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

925 file (file-name-nondirectory path)

926 initial file

927 cmpl (file-name-completion file dir)

928 listfunc (list 'lambda nil

929 (list 'file-name-all-completions

930 file dir))

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

932 (cond

933 ((stringp cmpl)

934 (if (string= initial cmpl)

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

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

937 (princ

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

939 (delete-region (point) beg)

940 (insert cmpl)))

941 ((null cmpl)

942 (ding))

943 ((eq t cmpl)

944 (save-excursion

945 (unwind-protect

946 (progn

947 (goto-char p)

948 (insert " [Sole completion]"))

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

950

951 ;

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

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

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

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

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

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

958 ;

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

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

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

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

963 (defvar yahtml-unsafe-chars-regexp

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

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

966 ;

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

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

969 ;

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

971 ; "$" | ","

972 (defvar yahtml-unreserved-chars-regexp

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

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

975 Not used yet.")

976

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

978 "Translate reserved chars to URL encoded string."

979 (let ((p 0) (target "")

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

981 (cond

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

983 (t

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

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

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

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

988 (setq target (concat target

989 (substring str 0 p)

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

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

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

993 (concat target str)))))

994

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

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

997 (interactive "r")

998 (save-excursion

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

1000 (goto-char beg)

1001 (while (and (< (point) e)

1002 (re-search-forward

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

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

1005 (sit-for 0)

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

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

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

1009 ; (unwind-protect

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

1011 ; (save-excursion

1012 ; (backward-char 1)

1013 ; (delete-backward-char 4))

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

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

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

1017 (progn

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

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

1020 (set-marker e nil))))

1021 ;; ab%defgls/.|

1022

1023 (defun yahtml:a ()

1024 "Add-in function for <a>"

1025 (let ((href ""))

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

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

1028 href (yahtml-escape-chars-string

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

1030 (prog1

1031 (concat (yahtml-make-optional-argument

1032 "href" href)

1033 (yahtml-make-optional-argument

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

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

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

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

1038 (YaTeX-update-table

1039 (list href)

1040 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

1041 )))

1042

1043 (defvar yahtml-parameters-completion-alist

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

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

1046 ("src" . file)

1047 ("background" . file)

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

1049 ("method" ("POST") ("GET"))

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

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

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

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

1054 ("http-equiv" ("Refresh"))))

1055

1056 (defvar yahtml-link-types-alist

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

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

1059 ("subsection") ("appendix") ("help") ("bookmark")))

1060

1061 (defvar yahtml-content-types-alist

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

1063 ("text/sgml") ("text/xml")

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

1065 ("application/java")

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

1067 "Alist of content-types")

1068

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

1070 (let* ((alist

1071 (cdr-safe (assoc (downcase par)

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

1073 (prompt (concat par ": "))

1074 v)

1075 (cond

1076 ((eq alist 'file)

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

1078 ((and alist (symbolp alist))

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

1080 (alist

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

1082 (t

1083 (read-string prompt default)))))

1084

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

1086 "Make optional argument string."

1087 (if (string= "" arg)

1088 ""

1089 (concat " "

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

1091 "=\"" arg "\"")))

1092

1093 (defun yahtml:body ()

1094 "Add-in function for <body>"

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

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

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

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

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

1100 (concat

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

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

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

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

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

1106

1107 (defun yahtml:img ()

1108 "Add-in function for <img>"

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

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

1111 alt

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

1113 (l yahtml-prefer-upcase-attributes)

1114 info width height bytes comments)

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

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

1117 (car info)

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

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

1120 bytes (car (cdr (cdr info)))

1121 comments (nth 4 info)))

1122 (if info

1123 (setq alt

1124 (YaTeX-replace-formats

1125 yahtml:img-default-alt-format

1126 (list (cons "x" width)

1127 (cons "y" height)

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

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

1130 (cons "c" (car comments))))))

1131

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

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

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

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

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

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

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

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

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

1141

1142 (defun yahtml-file-truename (file)

1143 (cond

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

1145 (t (let ((new file))

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

1147 (not (equal new file)))

1148 (setq file new))

1149 file))))

1150

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

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

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

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

1155 (let ((mlt 1)

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

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

1158 (value 0))

1159 (while (> length 0)

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

1161 pos (+ pos direc)

1162 mlt (* mlt 256)

1163 length (1- length)))

1164 value))

1165

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

1167 "Return the information on the image file FILE.

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

1169 (save-excursion

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

1171 width height bytes depth comment

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

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

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

1175 (seekpoint 1)

1176 c1 c2 c3 c4 beg end

1177 (case-fold-search nil))

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

1179 (set-buffer tmpbuf)

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

1181 (erase-buffer)

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

1183 (unwind-protect

1184 (progn

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

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

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

1188 (YaTeX-insert-file-contents

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

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

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

1192 c2 (char-after 2)

1193 c3 (char-after 3)

1194 c4 (char-after 4))

1195 (cond

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

1197 ;;JPEG images need JPEG markers inspection

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

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

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

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

1202 (catch 'exit

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

1204 (cond

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

1206 ;maybe corrupted, exit from loop

1207 (throw 'exit t))

1208 ((memq

1209 (char-after (1+ seekpoint))

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

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

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

1213 ;;found!

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

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

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

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

1218 ;; JPEG comment area

1219 (setq beg (+ seekpoint 2 2)

1220 end (+ seekpoint

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

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

1223 (t ;other markers

1224 nil)) ;just skip it

1225 (setq seekpoint (+ seekpoint 2)

1226 seekpoint (+ seekpoint

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

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

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

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

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

1232 height (yahtml-hex-value 20 4)

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

1234 ((looking-at "GIF8")

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

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

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

1238 ((looking-at "BM")

1239 ;;# OS/2, Windoze BMP files

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

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

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

1243 (cond

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

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

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

1247 (t

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

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

1250 ))

1251 (message "")

1252 (kill-buffer tmpbuf))

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

1254

1255 (defun yahtml:form ()

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

1257 (concat

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

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

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

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

1262 ))

1263

1264 (defun yahtml:select ()

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

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

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

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

1269

1270 (defun yahtml:ol ()

1271 "Add-in function for <ol>"

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

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

1274 (type (completing-read

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

1276 (concat

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

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

1279 (defun yahtml:ul ()

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

1281 (defun yahtml:dl ()

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

1283 (defun yahtml:dt ()

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

1285

1286 (defun yahtml:p ()

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

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

1289 ))

1290

1291 (defvar yahtml-input-types

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

1293 ("reset") ("image") ("hidden") ("file")))

1294

1295 (defun yahtml:input ()

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

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

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

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

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

1301 yahtml-input-types nil t)

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

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

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

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

1306 (concat

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

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

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

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

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

1312 )))

1313

1314 (defun yahtml:textarea ()

1315 "Add-in function for `textarea'"

1316 (interactive)

1317 (let (name rows cols)

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

1319 cols (read-string "Columns: ")

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

1321 (concat

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

1323 "\"" name "\"")

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

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

1326

1327 (defun yahtml:table ()

1328 "Add-in function for `table'"

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

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

1331 (concat

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

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

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

1335 (defun yahtml:caption ()

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

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

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

1339

1340 (defun yahtml:font ()

1341 "Add-in function for `font'"

1342 (concat

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

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

1345

1346 (defun yahtml:style ()

1347 "Add-in function for `style'"

1348 (yahtml-make-optional-argument

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

1350

1351 (defun yahtml:tr ()

1352 "Add-in function for `tr'"

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

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

1355 "")

1356

1357 (defun yahtml:link ()

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

1359 (let (rel rev type href)

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

1361 (cond

1362 ((equal rel "")

1363 (concat (yahtml-make-optional-argument

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

1365 (yahtml-make-optional-argument

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

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

1368 )))

1369 ((string-match "stylesheet" rel)

1370 (concat

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

1372 (yahtml-make-optional-argument

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

1374 (progn

1375 (setq href

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

1377 (if (string< "" href)

1378 (progn

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

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

1381 (setq yahtml-css-class-alist

1382 (yahtml-css-collect-classes-file

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

1384 (message "")

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

1386 (t ;;??

1387 ))))

1388

1389 (defvar yahtml:meta-names

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

1391

1392 (defun yahtml:meta ()

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

1394 "name"

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

1396 http-equiv content)

1397 (if (string= "" name)

1398 (if (string-match

1399 "Content-type"

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

1401 "http-equiv"

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

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

1404 "See docs/qanda")

1405 (concat http-equiv

1406 (yahtml-make-optional-argument

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

1408 (concat

1409 name

1410 (yahtml-make-optional-argument

1411 "content"

1412 (cond

1413 ((string-match "date" name)

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

1415 ((string-match "author" name)

1416 (read-string "Author: "

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

1418 (user-full-name)

1419 (user-login-name))))

1420 ((string-match "GENERATOR" name)

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

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

1423 (message "Thank you!"))

1424 content)

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

1426

1427 (defun yahtml:br ()

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

1429

1430 (defun yahtml:object ()

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

1432 data classid)

1433 (cond

1434 ((string-match "java" codetype)

1435 (let ((completion-ignored-extensions

1436 ;;any extensions except ".class"

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

1438 (setq classid (concat "java:"

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

1440 (concat

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

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

1443 (yahtml-make-optional-argument

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

1445 (yahtml-make-optional-argument

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

1447 (yahtml-make-optional-argument

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

1449 ))

1450 (t

1451 ""

1452 ))))

1453

1454 ;;; ---------- Simple tag ----------

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

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

1457 (interactive "P")

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

1459 (or tag

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

1461 (setq tag

1462 (YaTeX-cplread-with-learning

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

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

1465 'yahtml-typeface-table 'yahtml-user-typeface-table

1466 'yahtml-tmp-typeface-table))))

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

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

1469 (setq yahtml-last-typeface-cmd tag

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

1471 (if region-mode

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

1473 (save-excursion

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

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

1476 (exchange-point-and-mark)

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

1478 (message "No mark set now"))

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

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

1481

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

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

1484 (interactive)

1485 (yahtml-insert-tag t tag))

1486

1487

1488 (defun yahtml-insert-single (cmd)

1489 "Insert <CMD>."

1490 (interactive

1491 (list

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

1493 (YaTeX-cplread-with-learning

1494 (format "Command%s: "

1495 (if yahtml-last-single-cmd

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

1497 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1500 (setq yahtml-last-single-cmd

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

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

1503 yahtml-last-single-cmd))

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

1505

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

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

1508 (interactive "P")

1509 (if arg (yahtml-insert-tag nil "p")

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

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

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

1513

1514 (defun yahtml-insert-amps (arg)

1515 "Insert char-entity references via ampersand"

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

1517 (interactive "P")

1518 (let*((mess "") c

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

1520 yahtml-entity-reference-chars-alist))

1521 (l list))

1522 (while l

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

1524 l (cdr l)))

1525 (message "Char-entity reference: %s SPC=& RET=&; Other=&#..;" mess)

1526 (setq c (read-char))

1527 (cond

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

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

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

1531 (insert "&;")

1532 (forward-char -1))

1533 ((equal c ? )

1534 (insert ?&))

1535 (t (insert (format "&#%d;" c))))))

1536

1537 ;;; ---------- Jump ----------

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

1539 "Check if point is on href clause."

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

1541 (save-excursion

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

1543 (save-excursion

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

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

1546 (setq e (point)))

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

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

1549 (search-forward "href" e t)

1550 (search-forward "=" e t)

1551 (progn

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

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

1554 (< p (match-end 0))

1555 (YaTeX-match-string 1)

1556 ))))

1557

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

1559 (cond

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

1561 (set-process-buffer proc nil))

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

1563 (let ((cb (current-buffer)))

1564 (set-buffer (process-buffer proc))

1565 (goto-char (point-min))

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

1567 (progn

1568 (message "Starting netscape...")

1569 (start-process

1570 "browser" (process-buffer proc)

1571 shell-file-name yahtml-shell-command-option

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

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

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

1575 (set-buffer cb)))))

1576

1577 (defvar yahtml-browser-process nil)

1578

1579 (defun yahtml-browse-html (href)

1580 "Call WWW Browser to see HREF."

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

1582 (cond

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

1584 (if (get-buffer pb)

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

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

1587 (set-process-sentinel

1588 (setq yahtml-browser-process

1589 (start-process

1590 "browser" pb shell-file-name yahtml-shell-command-option

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

1592 'yahtml-netscape-sentinel))

1593 ((and (string-match "[Nn]etscape" yahtml-www-browser)

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

1595 (if (get-buffer pb)

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

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

1598 (set-process-sentinel

1599 (setq yahtml-browser-process

1600 (start-process

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

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

1603 'yahtml-netscape-sentinel))

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

1605 (w3-fetch href))

1606 ((stringp yahtml-www-browser)

1607 (if (and yahtml-browser-process

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

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

1610 (setq yahtml-browser-process

1611 (start-process

1612 "browser" "* WWW Browser *"

1613 shell-file-name yahtml-shell-command-option

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

1615 (t

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

1617

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

1619 "Go to corresponding name."

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

1621 (if href

1622 (cond

1623 ((string-match "^\$ht\\|f\$tp:" href)

1624 (yahtml-browse-html href))

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

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

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

1628 (if (string< "" file)

1629 (progn

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

1631 (or (catch 'dirindex

1632 (mapcar

1633 (function

1634 (lambda (f)

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

1636 (throw 'dirindex

1637 (setq file (concat file f))))))

1638 (yahtml-get-directory-index))

1639 nil)

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

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

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

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

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

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

1646 (if name

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

1648 t)))))

1649

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

1651 "Jump to html's named tag."

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

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

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

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

1656

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

1658 "Check if point is on begend clause."

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

1660 (save-excursion

1661 (goto-char p)

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

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

1664 (looking-at

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

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

1667 )

1668 (condition-case nil

1669 (forward-list 1)

1670 (error nil))

1671 (< p (point)))

1672 (YaTeX-match-string 1)))))

1673

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

1675 "Go to corresponding opening/closing tag.

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

1677 (let ((cmd (yahtml-on-begend-p)) m0

1678 (p (point)) (case-fold-search t) func str (nest 0))

1679 (cond

1680 (cmd

1681 (setq m0 (match-beginning 0))

1682 (if (= (aref cmd 0) ?/) ;on </cmd> line

1683 (setq cmd (substring cmd 1)

1684 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1685 func 're-search-backward)

1686 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1687 func 're-search-forward))

1688 (while (and (>= nest 0) (funcall func str nil t))

1689 (if (equal m0 (match-beginning 0))

1690 nil

1691 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1692 (if (< nest 0)

1693 (goto-char (match-beginning 0))

1694 (funcall

1695 (if noerr 'message 'error)

1696 "Corresponding tag of `%s' not found." cmd)

1697 (goto-char p)

1698 nil))

1699 (t nil))))

1700

1701 (defun yahtml-current-tag ()

1702 "Return the current tag name."

1703 (save-excursion

1704 (let ((p (point)) b tag)

1705 (or (bobp)

1706 (looking-at "<")

1707 (progn (skip-chars-backward "^<") (forward-char -1)))

1708 (setq b (point))

1709 (skip-chars-forward "<")

1710 (setq tag (buffer-substring

1711 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1712 (goto-char b)

1713 (forward-list 1)

1714 (and (< p (point)) tag))))

1715

1716

1717 (defun yahtml-goto-corresponding-img ()

1718 "View image on point"

1719 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1720 (if (and tag

1721 (string-match "img" tag)

1722 (save-excursion

1723 (re-search-backward "<\\s *img" nil t)

1724 (re-search-forward "src=\"?\$[^\"> ]+\$\"?")

1725 (match-beginning 1)

1726 (setq image

1727 (buffer-substring (match-beginning 1) (match-end 1)))))

1728 (progn

1729 (message "Invoking %s %s..." yahtml-image-viewer image)

1730 (start-process

1731 "Viewer" " * Image Viewer *"

1732 shell-file-name yahtml-shell-command-option ;"-c"

1733 (concat yahtml-image-viewer " " image))

1734 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1735

1736 (defun yahtml-get-attrvalue (attr)

1737 "Extract current tag's attribute value from buffer."

1738 (let (e (case-fold-search t))

1739 (save-excursion

1740 (or (looking-at "<")

1741 (progn (skip-chars-backward "^<") (backward-char 1)))

1742 (setq e (save-excursion (forward-list 1) (point)))

1743 (if (and

1744 (re-search-forward (concat "\\b" attr "\\b") e t)

1745 (progn (skip-chars-forward " \t\n=")

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

1747 (YaTeX-match-string 1)))))

1748

1749 (defun yahtml-goto-corresponding-source (&optional other)

1750 "Goto applet's source."

1751 (let ((env (yahtml-current-tag)) s (p (point)))

1752 (cond

1753 ((string-match "applet" env)

1754 (if (setq s (yahtml-get-attrvalue "code"))

1755 (progn

1756 (setq s (YaTeX-match-string 1)

1757 s (concat

1758 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1759 ".java"))

1760 (if other (YaTeX-switch-to-buffer-other-window s)

1761 (YaTeX-switch-to-buffer s))

1762 s) ;return source file name

1763 (message "No applet source specified")

1764 (sit-for 1)

1765 nil))

1766 ((string-match "!--#include" env)

1767 (cond

1768 ((setq s (yahtml-get-attrvalue "file")) ;

1769 (if other (YaTeX-switch-to-buffer-other-window s)

1770 (YaTeX-switch-to-buffer s))

1771 s)

1772 ((setq s (yahtml-get-attrvalue "virtual"));

1773 (setq s (yahtml-url-to-path s))

1774 (if other (YaTeX-switch-to-buffer-other-window s)

1775 (YaTeX-switch-to-buffer s))

1776 s)))

1777 ((and (string-match "!--#exec" env)

1778 (setq s (yahtml-get-attrvalue "cmd")))

1779 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1780 (let ((b " *yahtmltmp*")) ;peek a little

1781 (unwind-protect

1782 (progn

1783 (set-buffer (get-buffer-create b))

1784 (YaTeX-insert-file-contents s nil 0 100)

1785 (if (looking-at "#!")

1786 (if other (YaTeX-switch-to-buffer-other-window s)

1787 (YaTeX-switch-to-buffer s))))

1788 (kill-buffer (get-buffer b)))

1789 (get-file-buffer s))))))

1790

1791 (defun yahtml-goto-corresponding-* (&optional other)

1792 "Go to corresponding object."

1793 (interactive)

1794 (cond

1795 ((yahtml-goto-corresponding-href other))

1796 ((yahtml-goto-corresponding-img))

1797 ((yahtml-goto-corresponding-begend))

1798 ((yahtml-goto-corresponding-source other))

1799 (t (message "I don't know where to go."))

1800 ))

1801

1802 (defun yahtml-goto-corresponding-*-other-window ()

1803 "Go to corresponding object."

1804 (interactive)

1805 (yahtml-goto-corresponding-* t))

1806

1807 (defun yahtml-visit-main ()

1808 "Go to parent file from where you visit current file."

1809 (interactive)

1810 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1811

1812 ;;; ---------- killing ----------

1813 (defun yahtml-kill-begend (&optional whole)

1814 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1815 (if tag

1816 (save-excursion

1817 (or (looking-at "<")

1818 (progn (skip-chars-backward "^<") (forward-char -1)))

1819 (setq p (point))

1820 (yahtml-goto-corresponding-begend)

1821 (or (looking-at "<")

1822 (progn (skip-chars-backward "^<") (forward-char -1)))

1823 (if (< (point) p) ;if on the opening tag

1824 (progn (setq q p p (point))

1825 (goto-char q))

1826 (setq q (point))) ;now q has end-line's (point)

1827 (if (not whole)

1828 (kill-region

1829 (progn (skip-chars-backward " \t")

1830 (if (setq bbolp (bolp)) (point) q))

1831 (progn (forward-list 1)

1832 (setq r (point))

1833 (skip-chars-forward " \t")

1834 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1835 (goto-char p)

1836 (skip-chars-backward " \t")

1837 (if (not whole)

1838 (progn

1839 (kill-append

1840 (buffer-substring

1841 (setq p (if (setq bbolp (bolp)) (point) p))

1842 (setq q (progn

1843 (forward-list 1)

1844 (setq r (point))

1845 (skip-chars-forward " \t")

1846 (if (and bbolp (eolp) (not (eobp)))

1847 (1+ (point))

1848 r))))

1849 t)

1850 (delete-region p q))

1851 (kill-region

1852 (if (bolp) (point) p)

1853 (progn (goto-char q)

1854 (forward-list 1)

1855 (setq r (point))

1856 (skip-chars-forward " \t")

1857 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1858 tag))))

1859

1860 (defun yahtml-kill-* (whole)

1861 "Kill current position's HTML tag (set)."

1862 (interactive "P")

1863 (cond

1864 ((yahtml-kill-begend whole))

1865 ))

1866

1867

1868 ;;; ---------- changing ----------

1869 (defun yahtml-on-assignment-p ()

1870 "Return if current point is on parameter assignment.

1871 If so, return parameter name, otherwise nil.

1872 This function should be able to treat white spaces in value, but not yet."

1873 (let ((p (point)))

1874 (save-excursion

1875 (put 'yahtml-on-assignment-p 'region nil)

1876 (skip-chars-backward "^ \t\n")

1877 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

1878 (< p (match-end 0))

1879 (>= p (1- (match-beginning 2)))

1880 (put 'yahtml-on-assignment-p 'region

1881 (cons (match-beginning 2) (match-end 2)))

1882 (YaTeX-match-string 1)))))

1883

1884 (defun yahtml-change-begend ()

1885 (let ((tag (yahtml-on-begend-p))

1886 (completion-ignore-case t)

1887 (case-fold-search t)

1888 (p (point)) (q (make-marker))

1889 (default (append yahtml-env-table yahtml-typeface-table))

1890 (user (append yahtml-user-env-table yahtml-user-typeface-table))

1891 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

1892 href b1 e1 attr new css)

1893 (cond

1894 (tag

1895 (cond

1896 ((and (string-match "^a$" tag)

1897 (save-excursion

1898 (and

1899 (re-search-backward "<a\\b" nil t)

1900 (progn

1901 (goto-char (match-end 0))

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

1903 (setq b1 (point))

1904 (search-forward ">" nil t))

1905 (setq e1 (match-beginning 0))

1906 (goto-char b1)

1907 (re-search-forward "href\\s *=" e1 t)

1908 (>= p (point))

1909 (progn

1910 (goto-char (match-end 0))

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

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

1913 (< p (match-end 0)))))

1914 (setq b1 (match-beginning 1) e1 (match-end 1)

1915 yahtml-completing-buffer (current-buffer)

1916 ;; yahtml-urls-local is buffer-local, so we must put

1917 ;; that into yahtml-urls here

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

1919 href (read-from-minibuffer

1920 "Change href to: " "" yahtml-url-completion-map))

1921 (if (string< "" href)

1922 (progn

1923 ;;(setq href ;??

1924 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

1925 (delete-region b1 e1)

1926 (goto-char b1)

1927 (insert href))))

1928 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

1929 (if (and (equal attr "class") ;treat "class" attribute specially

1930 (setq css (yahtml-css-get-element-completion-alist tag)))

1931 (setq new (yahtml-read-parameter ;should be made generic?

1932 attr nil (list (cons "class" css))))

1933 ;;other than "class", read parameter normally

1934 (setq new (yahtml-read-parameter attr)))

1935 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

1936 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

1937 (insert new))

1938 (t

1939 (save-excursion

1940 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

1941 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

1942 (skip-chars-forward "^A-Za-z")

1943 (set-marker q (point))

1944 (setq p (point))

1945 (yahtml-goto-corresponding-begend)

1946 (or (= (char-after (point)) ?<)

1947 (skip-chars-backward "^<"))

1948 (skip-chars-forward "^A-Za-z")

1949 (if (= (char-after (1- (point))) ?/)

1950 (progn

1951 (set-marker q (point))

1952 (goto-char p)))

1953 (setq tag (let ((completion-ignore-case t))

1954 (YaTeX-cplread-with-learning

1955 (format "Change `%s' to(default %s): "

1956 tag yahtml-last-begend)

1957 'default 'user 'tmp)))

1958 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1959 (if (string= "" tag) (setq tag yahtml-last-begend))

1960 (setq yahtml-last-begend

1961 (or (cdr (assoc tag yahtml-env-table)) tag)

1962 tag yahtml-last-begend)

1963 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

1964 (insert (format "%s%s" tag (yahtml-addin tag)))

1965 (goto-char q)

1966 (set-marker q nil)

1967 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1968 (insert tag))))

1969 t))))

1970

1971 (defun yahtml-change-command ()

1972 (let ((p (point)) (case-fold-search t) cmd par new

1973 (beg (make-marker)) (end (make-marker)))

1974 (skip-chars-backward "^<")

1975 (if (and

1976 (looking-at yahtml-command-regexp)

1977 (progn

1978 (set-marker beg (match-beginning 0))

1979 (set-marker end (match-end 0))

1980 t) ;for further work

1981 (progn

1982 (forward-char -1)

1983 (condition-case nil

1984 (forward-list 1)

1985 (error nil))

1986 (< p (point))))

1987 (progn

1988 (goto-char p)

1989 (if (setq par (yahtml-on-assignment-p))

1990 (progn

1991 (setq new (yahtml-read-parameter par))

1992 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

1993 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

1994 (setq new

1995 (YaTeX-cplread-with-learning

1996 "Change form to: "

1997 'yahtml-form-table 'yahtml-user-form-table

1998 'yahtml-tmp-form-table)))

1999 (delete-region beg end)

2000 (goto-char beg)

2001 (set-marker beg nil)

2002 (set-marker end nil)

2003 (insert new)

2004 t)

2005 (goto-char p)

2006 nil)))

2007

2008 (defun yahtml-change-* ()

2009 "Change current position's HTML tag (set)."

2010 (interactive)

2011 (cond

2012 ((yahtml-change-begend))

2013 ((yahtml-change-command))

2014 ))

2015

2016 ;;; ---------- commenting ----------

2017

2018 (defun yahtml-comment-region (&optional uncom)

2019 "Comment out region or environment."

2020 (interactive)

2021 (let ((e (make-marker)) be beg p)

2022 (cond

2023 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2024 (setq be (yahtml-on-begend-p))

2025 (save-excursion

2026 (setq p (point))

2027 (if (string-match "^/" be)

2028 (setq beg (progn (forward-line 1) (point)))

2029 (setq beg (progn (beginning-of-line) (point))))

2030 (goto-char p)

2031 (yahtml-goto-corresponding-begend)

2032 (if (string-match "^/" be)

2033 (beginning-of-line)

2034 (forward-line 1))

2035 (set-marker e (point))

2036 ;(comment-region beg (point) (if uncom (list 4)))

2037 ))

2038 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2039 (setq beg (region-beginning))

2040 (set-marker e (region-end))))

2041 (if yahtml-translate-hyphens-when-comment-region

2042 (let ((yahtml-entity-reference-chars-alist-default nil)

2043 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2044 yahtml-entity-reference-chars-regexp

2045 yahtml-entity-reference-chars-reverse-regexp)

2046 (yahtml-entity-reference-chars-setup)

2047 (funcall

2048 (if uncom 'yahtml-translate-reverse-region

2049 'yahtml-translate-region)

2050 beg e)))

2051 (comment-region beg e (if uncom (list 4)))

2052 (set-marker e nil)))

2053

2054 (defun yahtml-uncomment-region ()

2055 (interactive)

2056 (yahtml-comment-region t))

2057

2058 ;;; ---------- translate to entity references ----------

2059 (defvar yahtml-entity-reference-chars-alist-default

2060 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2061 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2062 "Default translation table from character to entity reference")

2063 (defvar yahtml-entity-reference-chars-alist nil

2064 "*Translation table from character to entity reference")

2065 (defvar yahtml-entity-reference-chars-regexp nil)

2066 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2067

2068 (defun yahtml-entity-reference-chars-setup ()

2069 (let ((list (append yahtml-entity-reference-chars-alist-default

2070 yahtml-entity-reference-chars-alist)))

2071 (setq yahtml-entity-reference-chars-regexp "["

2072 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2073 (while list

2074 (setq yahtml-entity-reference-chars-regexp

2075 (concat yahtml-entity-reference-chars-regexp

2076 (char-to-string (car (car list))))

2077 yahtml-entity-reference-chars-reverse-regexp

2078 (concat yahtml-entity-reference-chars-reverse-regexp

2079 (cdr (car list))

2080 (if (cdr list) "\\|")))

2081 (setq list (cdr list)))

2082 (setq yahtml-entity-reference-chars-regexp

2083 (concat yahtml-entity-reference-chars-regexp "]")

2084 yahtml-entity-reference-chars-reverse-regexp

2085 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2086

2087 (yahtml-entity-reference-chars-setup)

2088

2089 (defun yahtml-translate-region (beg end)

2090 "Translate inhibited literals."

2091 (interactive "r")

2092 (save-excursion

2093 (save-restriction

2094 (narrow-to-region beg end)

2095 (let ((ct (append yahtml-entity-reference-chars-alist

2096 yahtml-entity-reference-chars-alist-default)))

2097 (goto-char beg)

2098 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2099 ;(setq c (preceding-char))

2100 (replace-match

2101 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2102

2103 (defun yahtml-translate-reverse-region (beg end)

2104 "Translate entity references to literals."

2105 (interactive "r")

2106 (save-excursion

2107 (save-restriction

2108 (narrow-to-region beg end)

2109 (let ((ct (append yahtml-entity-reference-chars-alist

2110 yahtml-entity-reference-chars-alist-default))

2111 ec)

2112 (goto-char beg)

2113 (while (re-search-forward

2114 yahtml-entity-reference-chars-reverse-regexp nil t)

2115 ;(setq c (preceding-char))

2116 (setq ec (YaTeX-match-string 1))

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

2118 (insert (car (YaTeX-rassoc ec ct))))))))

2119

2120 (defun yahtml-inner-environment-but (exclude &optional quick)

2121 "Return the inner environment but matches with EXCLUDE tag."

2122 (let (e (case-fold-search t))

2123 (save-excursion

2124 (while (and (setq e (YaTeX-inner-environment quick))

2125 (string-match exclude e))

2126 (goto-char (get 'YaTeX-inner-environment 'point))))

2127 e))

2128

2129 ;;; ---------- filling ----------

2130 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2131 (defun yahtml-move-to-column (col &optional force)

2132 (beginning-of-line)

2133 (let ((ccol 0))

2134 (while (and (> col ccol) (not (eolp)))

2135 (if (eq (following-char) ?\<)

2136 (progn

2137 (while (and (not (eq (following-char) ?\>))

2138 (not (eolp)))

2139 (forward-char))

2140 (or (eolp) (forward-char)))

2141 (or (eolp) (forward-char))

2142 (if (eq (preceding-char) ?\t)

2143 (let ((wd (- 8 (% (+ ccol 8) 8))))

2144 (if (and force (< col (+ ccol wd)))

2145 (progn

2146 (backward-char 1)

2147 (insert-char ?\ (- col ccol))

2148 (setq ccol col))

2149 (setq ccol (+ ccol wd))))

2150 (setq ccol (1+ ccol)))

2151 (if (and YaTeX-japan

2152 (or

2153 (and (fboundp 'char-category)

2154 (string-match "[chj]" (char-category (preceding-char))))

2155 (and (fboundp 'char-charset)

2156 (not (eq (char-charset (preceding-char)) 'ascii)))))

2157 (setq ccol (1+ ccol)))))

2158 (if (and force (> col ccol))

2159 (progn

2160 (insert-char ?\ (- col ccol))

2161 col)

2162 ccol)))

2163

2164 (defun yahtml-fill-paragraph (arg)

2165 (interactive "P")

2166 (let*((case-fold-search t) (p (point)) fill-prefix

2167 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2168 indent

2169 (startp (get 'YaTeX-inner-environment 'point))

2170 (prep (string-match "^pre$" e))

2171 (ps1 (if prep (default-value 'paragraph-start)

2172 paragraph-start))

2173 (ps2 (if prep (concat (default-value 'paragraph-start)

2174 "$\\|^\\s *</?pre>")

2175 paragraph-start)))

2176 (save-excursion

2177 (unwind-protect

2178 (progn

2179 (if prep

2180 (fset 'move-to-column 'yahtml-move-to-column))

2181 (save-excursion

2182 (beginning-of-line)

2183 (indent-to-column (yahtml-this-indent))

2184 (setq fill-prefix

2185 (buffer-substring (point) (point-beginning-of-line)))

2186 (delete-region (point) (point-beginning-of-line)))

2187 (fill-region-as-paragraph

2188 (progn (re-search-backward paragraph-start nil t)

2189 (or (save-excursion

2190 (goto-char (match-beginning 0))

2191 (if (looking-at "<")

2192 (forward-list)

2193 (goto-char (match-end 0))

2194 (skip-chars-forward " \t>"))

2195 (if (looking-at "[ \t]*$")

2196 (progn (forward-line 1) (point))))

2197 (point)))

2198 (progn (goto-char p)

2199 (re-search-forward ps2 nil t)

2200 (match-beginning 0))))

2201 (fset 'move-to-column yahtml-saved-move-to-column)))))

2202

2203 ;(defun yahtml-indent-new-commnet-line ()

2204 ; (unwind-protect

2205 ; (progn

2206 ; (fset 'move-to-column 'yahtml-move-to-column)

2207 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2208 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2209

2210 ;;;

2211 ;;; ---------- indentation ----------

2212 ;;;

2213 (defun yahtml-indent-line ()

2214 "Indent a line (faster wrapper)"

2215 (interactive)

2216 (let (indent)

2217 (if (and (save-excursion

2218 (beginning-of-line) (skip-chars-forward "\t ")

2219 (not (looking-at "<")))

2220 (save-excursion

2221 (forward-line -1)

2222 (while (and (not (bobp)) (looking-at "^\\s *$"))

2223 (forward-line -1))

2224 (skip-chars-forward "\t ")

2225 (setq indent (current-column))

2226 (not (looking-at "<"))))

2227 (progn

2228 (save-excursion

2229 (beginning-of-line)

2230 (skip-chars-forward " \t")

2231 (or (= (current-column) indent)

2232 (YaTeX-reindent indent)))

2233 (and (bolp) (skip-chars-forward " \t")))

2234 (yahtml-indent-line-real))))

2235

2236 (defun yahtml-this-indent ()

2238 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2239 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2240 (excludes

2241 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2242 inenv p col peol (case-fold-search t))

2243 (save-excursion

2244 (beginning-of-line)

2245 (setq inenv (or (yahtml-inner-environment-but excludes t)

2246 "html")

2247 col (get 'YaTeX-inner-environment 'indent)

2248 p (get 'YaTeX-inner-environment 'point)

2249 op nil))

2250 (save-excursion

2251 (cond

2252 ((string-match (concat "^\$" envs "\$") inenv)

2253 (save-excursion

2254 (beginning-of-line)

2255 (skip-chars-forward " \t")

2256 (cond ;lookup current line's tag

2257 ((looking-at (concat "</\$" envs "\$>"))

2258 col)

2259 ((looking-at itms)

2260 (+ col yahtml-environment-indent))

2261 ((and yahtml-hate-too-deep-indentation

2262 (looking-at (concat "<\$" envs "\$")))

2263 (+ col (* 2 yahtml-environment-indent)))

2264 ((and (< p (point))

2265 (string-match itemizing-envs inenv)

2266 (save-excursion

2267 (and

2268 (setq op (point))

2269 (goto-char p)

2270 (re-search-forward itms op t)

2271 (progn

2272 (if yahtml-indent-listing-constant

2273 (setq col (+ (current-column)

2274 (if yahtml-faithful-to-htmllint 1 2)))

2275 (skip-chars-forward "^>")

2276 (skip-chars-forward ">")

2277 (skip-chars-forward " \t")

2278 (setq col (if (looking-at "$")

2279 (+ col yahtml-environment-indent)

2280 (current-column))))))))

2281 col)

2282 (t

2283 (+ col yahtml-environment-indent)))))

2284 (t col)))))

2285

2286 (defun yahtml-indent-line-real ()

2287 "Indent current line."

2288 (interactive)

2289 (YaTeX-reindent (yahtml-this-indent))

2290 (if (bolp) (skip-chars-forward " \t"))

2291 (let (peol col inenv)

2292 (if (and (setq inenv (yahtml-on-begend-p))

2293 (string-match

2294 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2295 (save-excursion

2296 (setq peol (point-end-of-line))

2297 (or (= (char-after (point)) ?<)

2298 (progn (skip-chars-backward "^<") (forward-char -1)))

2299 (setq col (current-column))

2300 (if (and (yahtml-goto-corresponding-begend t)

2301 (> (point) peol)) ;if on the different line

2302 (YaTeX-reindent col))))))

2303

2304 ;(defun yahtml-fill-item ()

2305 ; "Fill item HTML version"

2306 ; (interactive)

2307 ; (let (inenv p fill-prefix peol (case-fold-search t))

2308 ; (setq inenv (or (YaTeX-inner-environment) "html")

2309 ; p (get 'YaTeX-inner-environment 'point))

2310 ; (cond

2311 ; ((string-match "^[uod]l" inenv)

2312 ; (save-excursion

2313 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2314 ; (progn

2315 ; (goto-char (match-end 0))

2316 ; (setq col (current-column)))

2317 ; (error "No <li>, <dt>, <dd>")))

2318 ; (save-excursion

2319 ; (end-of-line)

2320 ; (setq peol (point))

2321 ; (newline)

2322 ; (indent-to-column col)

2323 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2324 ; (delete-region (point) peol)

2325 ; (fill-region-as-paragraph

2326 ; (progn (re-search-backward paragraph-start nil t) (point))

2327 ; (progn (re-search-forward paragraph-start nil t 2)

2328 ; (match-beginning 0)))))

2329 ; (t nil))))

2330

2331 ;;;

2332 ;;; ---------- Lint and Browsing ----------

2333 ;;;

2334 (defun yahtml-browse-menu ()

2335 "Browsing menu"

2336 (interactive)

2337 (message "J)weblint p)Browse R)eload...")

2338 (let ((c (char-to-string (read-char))))

2339 (cond

2340 ((string-match "j" c)

2341 (yahtml-lint-buffer (current-buffer)))

2342 ((string-match "[bp]" c)

2343 (yahtml-browse-current-file))

2344 ((string-match "r" c)

2345 (yahtml-browse-reload)))))

2346

2347 (if (fboundp 'wrap-function-to-control-ime)

2348 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2349

2350 (defvar yahtml-lint-buffer "*weblint*")

2351

2352 (defun yahtml-lint-buffer (buf)

2353 "Call lint on buffer BUF."

2354 (require 'yatexprc)

2355 (interactive "bCall lint on buffer: ")

2356 (setq buf (get-buffer buf))

2357 (YaTeX-save-buffers)

2358 (YaTeX-typeset

2359 (concat yahtml-lint-program " "

2360 (file-name-nondirectory (buffer-file-name buf)))

2361 yahtml-lint-buffer "lint" "lint"))

2362

2363 (defun yahtml-file-to-url (file)

2364 "Convert local unix file name to URL.

2365 If no matches found in yahtml-path-url-alist, return raw file name."

2366 (let ((list yahtml-path-url-alist) p url)

2367 (if (file-directory-p file)

2368 (setq file (expand-file-name yahtml-directory-index file))

2369 (setq file (expand-file-name file)))

2370 (if (string-match "^[A-Za-z]:/" file)

2371 (progn

2372 ;; (aset file 1 ?|) ;これは要らないらしい…

2373 (setq file (concat "///" file))))

2374 (while list

2375 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2376 (setq url (cdr (car list))

2377 file (substring file (match-end 0))

2378 url (concat url file)

2379 list nil))

2380 (setq list (cdr list)))

2381 (or url (concat "file:" file))))

2382

2383 (defun yahtml-url-to-path (file &optional basedir)

2384 "Convert local URL name to unix file name."

2385 (let ((list yahtml-path-url-alist) url realpath docroot

2386 (dirsufp (string-match "/$" file)))

2387 (setq basedir (or basedir

2388 (file-name-directory

2389 (expand-file-name default-directory))))

2390 (cond

2391 ((string-match "^/" file)

2392 (while list

2393 (if (file-directory-p (car (car list)))

2394 (progn

2395 (setq url (cdr (car list)))

2396 (if (string-match "\$http://[^/]*\$/" url)

2397 (setq docroot (substring url (match-end 1)))

2398 (setq docroot url))

2399 (cond

2400 ((string-match (concat "^" (regexp-quote docroot)) file)

2401 (setq realpath

2402 (expand-file-name

2403 (substring

2404 file

2405 (if (= (aref file (1- (match-end 0))) ?/)

2406 (match-end 0) ; "/foo"

2407 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2408 (car (car list))))))

2409 (if realpath

2410 (progn (setq list nil)

2411 (if (and dirsufp (not (string-match "/$" realpath)))

2412 (setq realpath (concat realpath "/")))))))

2413 (setq list (cdr list)))

2414 realpath)

2415 (t file))))

2416

2417 (defun yahtml-browse-current-file ()

2418 "Call WWW browser on current file."

2419 (interactive)

2420 (basic-save-buffer)

2421 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2422

2423 (defun yahtml-browse-reload ()

2424 "Send `reload' event to netzscape."

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

2426 (cond

2427 ((string-match "[Nn]etscape" yahtml-www-browser)

2428 (if (get-buffer pb)

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

2430 ;;(or (get 'yahtml-netscape-sentinel 'url)

2431 ;; (error "Reload should be called after Browsing."))

2432 (put 'yahtml-netscape-sentinel 'url

2433 (yahtml-file-to-url (buffer-file-name)))

2434 (basic-save-buffer)

2435 (set-process-sentinel

2436 (setq yahtml-browser-process

2437 (start-process

2438 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2439 (format "%s -remote 'reload'" yahtml-www-browser)))

2440 'yahtml-netscape-sentinel))

2441 (t

2442 (message "Sorry, RELOAD is supported only for Netscape.")))))

2443

2444 ;;; ---------- Intelligent newline ----------

2445 (defun yahtml-intelligent-newline (arg)

2446 "Intelligent newline for HTML"

2447 (interactive "P")

2448 (let (env func)

2449 (end-of-line)

2450 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2451 "html")))

2452 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2453 (newline)

2454 (if (and env func (fboundp func))

2455 ;; if intelligent line function is defined, call that

2456 (funcall func)

2457 ;; else do the default action

2458 (if (string-match yahtml-p-prefered-env-regexp env)

2459 (yahtml-insert-p)))))

2460

2461 (defun yahtml-intelligent-newline-ul ()

2462 (interactive)

2463 (yahtml-insert-single "li")

2464 (or yahtml-faithful-to-htmllint (insert " "))

2465 (yahtml-indent-line))

2466

2467 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2468

2469 (defun yahtml-intelligent-newline-dl ()

2470 (interactive)

2471 (let ((case-fold-search t))

2472 (if (save-excursion

2473 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2474 (get 'YaTeX-inner-environment 'point) t))

2475 (cond

2476 ((match-beginning 2)

2477 (yahtml-insert-single "dd")

2478 (or yahtml-faithful-to-htmllint (insert " "))

2479 (setq yahtml-last-single-cmd "dt"))

2480 ((match-beginning 3)

2481 (yahtml-insert-single "dt")

2482 (or yahtml-faithful-to-htmllint (insert " "))

2483 (setq yahtml-last-single-cmd "dd")))

2484 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

2485 (setq yahtml-last-single-cmd "dd"))

2486 (yahtml-indent-line)

2487 (and (string-match yahtml-p-prefered-env-regexp "dl")

2488 (string-equal yahtml-last-single-cmd "dt")

2489 (yahtml-insert-p nil))))

2490

2491 (defun yahtml-intelligent-newline-select ()

2492 (interactive)

2493 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2494 (yahtml-indent-line))

2495

2496 (defun yahtml-intelligent-newline-style ()

2497 (interactive)

2498 (if (save-excursion

2499 (and

2500 (re-search-backward "<style\\|<!-- " nil t)

2501 (looking-at "<style")))

2502 (let (c)

2503 (yahtml-indent-line)

2504 (setq c (current-column))

2505 (insert "<!--\n")

2506 (YaTeX-reindent c)

2507 (insert "-->")

2508 (beginning-of-line)

2509 (open-line 1)

2510 (YaTeX-reindent c))))

2511

2512 ;;; ---------- Marking ----------

2513 (defun yahtml-mark-begend ()

2514 "Mark current tag"

2515 (interactive)

2516 (YaTeX-beginning-of-environment)

2517 (let ((p (point)))

2518 (save-excursion

2519 (skip-chars-backward " \t" (point-beginning-of-line))

2520 (if (bolp) (setq p (point))))

2521 (push-mark p t))

2522 (yahtml-goto-corresponding-begend)

2523 (forward-list 1)

2524 (if (eolp) (forward-char 1)))

2525

2526 ;;; ---------- complete marks ----------

2527 (defun yahtml-complete-mark ()

2528 "Complete &gt, &lt, &ampersand, and &quote."

2529 (interactive)

2530 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2531 (let ((c (read-char)))

2532 (setq c (if (or (< c ?0) (> c ?7))

2533 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2534 (- c ?1)))

2535 (if (or (< c 0) (> c 6))

2536 nil

2537 (insert (format "&%s;"

2538 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2539

2540

2541 ;;; ---------- jump to error line ----------

2542 (defun yahtml-prev-error ()

2543 "Jump to previous error seeing lint buffer."

2544 (interactive)

2545 (or (get-buffer yahtml-lint-buffer)

2546 (error "No lint program ran."))

2547 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2548 (yahtml-jump-to-error-line t))

2549

2550 (defun yahtml-jump-to-error-line (&optional sit)

2551 (interactive "P")

2552 (let ((p (point)) (e (point-end-of-line)))

2553 (end-of-line)

2554 (if (re-search-backward yahtml-error-line-regexp nil t)

2555 (let ((f (if (string= "" (YaTeX-match-string 1))

2556 YaTeX-current-file-name

2557 (YaTeX-match-string 1)))

2558 (l (string-to-int (or (YaTeX-match-string 2)

2559 (YaTeX-match-string 3)))))

2560 (if sit (sit-for 1))

2561 (forward-line -1)

2562 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2563 (goto-line l))

2564 (message "No line number usage"))))

2565

2566 ;;; ---------- Style Sheet Support ----------

2567 (defvar yahtml-css-class-alist nil

2568 "Alist of elements vs. their classes")

2569

2570 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2571 (save-excursion

2572 (save-restriction

2573 (narrow-to-region beg end)

2574 (goto-char (point-min))

2575 (let ((alist initial) b e element class a)

2576 (setq b (point))

2577 (while (search-forward "{" nil t)

2578 (setq e (point))

2579 (goto-char b)

2580 (while (re-search-forward ;ちょといい加減なREGEXP

2581 "\$[a-z][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>" e t)

2582 (setq element (YaTeX-match-string 1)

2583 class (YaTeX-match-string 2))

2584 ;;if starts with period (match-string 1 is nil),

2585 ;;this is global class

2586 (setq element (downcase (or element "global")))

2587 (if (setq a (assoc element alist))

2588 (or (assoc class (cdr a))

2589 (setcdr a (cons (list class) (cdr a))))

2590 (setq alist (cons (list element (list class)) alist))))

2591 (goto-char (1- e))

2592 (search-forward "}" nil t)

2593 (setq b (point)))

2594 alist))))

2595

2596 (defun yahtml-css-collect-classes-buffer (&optional initial)

2597 (interactive)

2598 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2599

2600 (defun yahtml-css-collect-classes-file (file &optional initial)

2601 (let*((hilit-auto-highlight nil)

2602 (openedp (get-file-buffer file))

2603 (cb (current-buffer))

2604 (buf (set-buffer (find-file-noselect file))))

2605 (prog1

2606 (yahtml-css-collect-classes-buffer initial)

2607 (or openedp (kill-buffer buf))

2608 (set-buffer cb))))

2609

2610 (defun yahtml-css-scan-styles ()

2611 (save-excursion

2612 (goto-char (point-min))

2613 (set (make-local-variable 'yahtml-css-class-alist) nil)

2614 (let (b tag type e href alist)

2615 (while (re-search-forward "<\$style\\|link\$" nil t)

2616 (setq b (match-beginning 0)

2617 tag (YaTeX-match-string 1))

2618 (cond

2619 ((string-match "style" tag)

2620 (goto-char b)

2621 (save-excursion (forward-list 1) (setq e (point)))

2622 (cond

2623 ((search-forward "text/css" e 1) ;css definition starts

2624 (setq alist

2625 (yahtml-css-collect-classes-region

2626 (point) (progn (search-forward "</style>") (point))

2627 alist)))))

2628 ((and (string-match "link" tag)

2629 (stringp (setq type (yahtml-get-attrvalue "type")))

2630 (string-match "text/css" type)

2631 (setq href (yahtml-get-attrvalue "href"))

2632 (file-exists-p (yahtml-url-to-path href)))

2633 (setq alist

2634 (yahtml-css-collect-classes-file

2635 (yahtml-url-to-path href) alist))))

2636 (setq yahtml-css-class-alist alist)))))

2637

2638 (defun yahtml-css-get-element-completion-alist (element)

2639 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

2640 (global (cdr-safe (assoc "global" yahtml-css-class-alist))))

2641 (and (or alist global)

2642 (append alist global))))

2643

2644 ;;; ---------- ----------

2645

2646 ;;;

2647 ;;hilit19

2648 ;;;

2649 (defvar yahtml-default-face-table

2650 '(

2651 (form black/ivory white/hex-442233 italic)

2652 ))

2653 (defvar yahtml-hilit-patterns-alist

2654 '(

2655 'case-fold

2656 ;; comments

2657 ("" comment)

2658 ;; include&exec

2659 ("" include)

2660 ;; string

2661 (hilit-string-find ?\\ string)

2662 (yahtml-hilit-region-tag "<\$em\\|strong\\|b\$\\>" bold)

2663 ("</?[uod]l>" 0 decl)

2664 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2665 (yahtml-hilit-region-tag "<\$i\\>\$" italic)

2666 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

2667 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

2668 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2669 ))

2670

2671 (defun yahtml-hilit-region-tag (tag)

2672 "Return list of start/end point of <TAG> form."

2673 (if (re-search-forward tag nil t)

2674 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

2675 (elm (YaTeX-match-string 1)))

2676 (skip-chars-forward "^>")

2677 (prog1

2678 (cons (1+ (point))

2679 (progn (re-search-forward (concat "</" elm ">") nil t)

2680 (match-beginning 0)))

2681 (goto-char e0)))))

2682

2683 (defun yahtml-hilit-region-tag-itself (ptn)

2684 "Return list of start/end point of <tag options...> itself."

2685 (if (re-search-forward ptn nil t)

2686 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

2687 (skip-chars-forward "^<>")

2688 (if (eq (char-after (point)) ?<) nil

2689 (prog1

2690 (cons m0 (min (point-max) (1+ (point))))

2691 (goto-char e0))))))

2692

2693 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2694 (and yahtml-use-hilit19

2695 (or (assq 'yahtml-mode hilit-patterns-alist)

2696 (setq hilit-patterns-alist

2697 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2698 hilit-patterns-alist))))

2699 ;;;

2700 ;; for font-lock

2701 ;;;

2702

2703 ; <<STATIC KEYWORDS BELOW NOT USED>>

2704 ;(defvar yahtml-font-lock-keywords

2705 ; '(

2706 ; ;; comments

2707 ; ("" . font-lock-comment-face)

2708 ; ;; include&exec

2709 ; (""

2710 ; 0 font-lock-include-face keep)

2711 ; ;; string

2712 ; ;(hilit-string-find ?\\ string)

2713 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2714 ; ("</?[uod]l>" 0 font-lock-keyword-face)

2715 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

2716 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

2717 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2718 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

2719 ; )

2720 ; "*Defualt font-lock-keywords for yahtml-mode.")

2721 (defvar yahtml-font-lock-keywords

2722 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

2723 "Default fontifying patterns for yahtml-mode")

2724

2725 (defun yahtml-font-lock-set-default-keywords ()

2726 (put 'yahtml-mode 'font-lock-defaults

2727 '(yahtml-font-lock-keywords nil t)))

2728

2729 (if yahtml-use-font-lock

2730 (progn

2731 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

2732 ;;for those who use both hilit19 and font-lock

2733 (if (eq (car hilit-mode-enable-list) 'not)

2734 (or (member 'yahtml-mode hilit-mode-enable-list)

2735 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

2736 (setq hilit-mode-enable-list

2737 (delq 'yahtml-mode hilit-mode-enable-list))))

2738 (yahtml-font-lock-set-default-keywords)))

2739

2740 (defun yahtml-font-lock-recenter (&optional arg)

2741 (interactive "P")

2742 (font-lock-mode -1) ;is stupid, but sure.

2743 (font-lock-mode 1))

2744

2745 ;; (defun yahtml-fontify-to-tagend (lim)

2746 ;; "*Fontify any tag including < and >.

2747 ;; This is invalid use of font-lock function. Therefore

2748 ;; this fontifying will loose effectiveness soon or later."

2749 ;; (let ((start (match-beginning 0))

2750 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))

2751 ;; (or nil; (font-lock-any-faces-p start end)

2752 ;; (font-lock-fillin-text-property

2753 ;; start end 'face 'font-lock font-lock-keyword-face)))

2754 ;; nil)

2755

2756 (run-hooks 'yahtml-load-hook)

2757 (provide 'yahtml)

2758

2759 ; Local variables:

2760 ; fill-prefix: ";;; "

2761 ; paragraph-start: "^$\\|\\|;;;$"

2762 ; paragraph-separate: "^$\\|\\|;;;$"

2763 ; buffer-file-coding-system: sjis

2764 ; End: