yatex: 807c1e7e68b7 yahtml.el

yatex

view yahtml.el @ 69:807c1e7e68b7

yahtml-escape-chars-region Translate <>"& to entity reference. And inverse translation to above. yahtml-translate-hyphens-when-comment-region yahtml-prefer-upcase-attributes Inquire .htaccess file to determine the file-coding-system. Completions for StyleSheet. ---yahtml--- Auto insert of \), \|, \] after corresponding \(, \| \]. [prefix] c for \right\left parens.

author	yuuji
date	Thu, 15 Jul 1999 04:58:26 +0000
parents	0eb6997bee16
children	44e3a5e1e883

line source

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

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

3 ;;; Last modified Wed Jul 14 18:01:18 1999 on firestorm

4 ;;; $Id$

6 ;;;[Installation]

7 ;;;

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

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

10 ;;;

11 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

20 ;;;

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

22 ;;;

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

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

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

26 ;;;

27 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

36 ;;;

37 ;;;[Commentary]

38 ;;;

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

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

41 ;;;

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

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

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

45 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

70 ;;; change the reference link with completion.

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

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

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

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

75 ;;; is "netscape")

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

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

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

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

80 ;;; in the region.

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

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

83 ;;; URLencoded string in the region.

84 ;;;

85 ;;;[キーの説明]

86 ;;;

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

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

89 ;;;

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

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

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

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

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

95 ;;; できます。

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

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

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

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

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

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

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

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

104 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

116 ;;; す。

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

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

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

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

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

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

123 ;;; きます。

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

125 ;;; す。

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

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

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

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

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

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

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

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

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

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

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

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

138 ;;;

139 ;;; [謝辞]

140 ;;;

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

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

143 ;;;

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

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

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

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

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

149 ;;;

150

151

152 ;(require 'yatex)

153 (require 'yatexlib)

154 ;;; --- customizable variable starts here ---

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

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

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

158 (defvar yahtml-www-browser "netscape"

159 "*WWW Browser command")

160 (defvar yahtml-kanji-code 2

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

162 ;;(defvar yahtml-coding-system

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

164 ;; "Kanji coding system")

165 (and (featurep 'mule)

166 (integerp yahtml-kanji-code)

167 (setq yahtml-kanji-code

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

169

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

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

172

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

174 (defvar yahtml-path-url-alist nil

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

176 Ex.

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

178 (\"/usr/home/yuuji/darts/http\" . \"http://darts.comp.ae.keio.ac.jp/~darts\"))")

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

180 "*Directory index file name;

181 Consult your site's WWW administrator.")

182

183 (defvar yahtml-environment-indent 1

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

185

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

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

188

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

190 "*Program name to lint HTML file")

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

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

193

194 (defvar yahtml-always-/p nil

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

196

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

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

199

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

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

202

203 (defvar yahtml-prefer-upcases nil

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

205

206 (defvar yahtml-prefer-upcase-attributes nil

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

208

209 (defvar yahtml-server-type 'apache

210 "*WWW server program type")

211

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

213 "*Server access file name for apache")

214

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

216

217 ;;; --- customizable variable ends here ---

218 (defvar yahtml-prefix-map nil)

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

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

221 (defvar yahtml-shell-command-option

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

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

224

225

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

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

228 (YaTeX-define-key

229 key

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

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

232 map))

233

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

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

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

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

238

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

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

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

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

243 (if YaTeX-inhibit-prefix-letter nil

244 (yahtml-define-begend-region-key

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

246

247 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

258 (let ((map yahtml-prefix-map))

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

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

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

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

263 (and YaTeX-emacs-19 window-system

264 (progn

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

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

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

268 (YaTeX-define-key "v" 'YaTeX-version map)

269 (YaTeX-define-key "}" 'YaTeX-insert-braces-region map)

270 (YaTeX-define-key "]" 'YaTeX-insert-brackets-region map)

271 (YaTeX-define-key ")" 'YaTeX-insert-parens-region map)

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

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

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

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

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

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

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

279 (if YaTeX-no-begend-shortcut

280 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

299 )

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

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

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

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

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

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

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

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

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

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

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

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

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

313 ))

314

315 (if yahtml-lint-buffer-map nil

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

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

318

319

320 (defvar yahtml-paragraph-start

321 (concat

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

323 "*Regexp of html paragraph separater")

324 (defvar yahtml-paragraph-separate

325 (concat

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

327 "*Regexp of html paragraph separater")

328 (defvar yahtml-syntax-table nil

329 "*Syntax table for yahtml-mode")

330

331 (if yahtml-syntax-table nil

332 (setq yahtml-syntax-table

333 (make-syntax-table (standard-syntax-table)))

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

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

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

337 )

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

339 "Regexp of constituent of html commands.")

340

341 ;;; Completion tables for `form'

342 (defvar yahtml-form-table

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

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

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

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

347

348 (defvar yahtml-env-table

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

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

351 ("OrderedList" . "ol")

352 ("UnorderedList" . "ul")

353 ("DefinitionList" . "dl")

354 ("Preformatted" . "pre")

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

356 ("address")

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

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

359 ("style") ("div")

360 ))

361

362 ;(defvar yahtml-itemizing-regexp

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

364 ; "Regexp of itemizing forms")

365

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

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

368

369 ;;; Completion tables for typeface designator

370 (and yahtml-always-/p

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

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

373

374 (defvar yahtml-typeface-table

375 (append

376 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("strike")

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

378 ("sup") ("sub") ("span"))

379 yahtml-env-table)

380 "Default completion table of typeface designator")

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

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

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

384

385 (defvar yahtml-single-cmd-table

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

387 ("HorizontalLine" . "hr")

388 ("BreakLine" . "br")

389 ("Paragraph" . "p")

390 ("Item" . "li")

391 ("DefineTerm" . "dt")

392 ("Description" . "dd")

393 ("dd") ("dt") ("li")

394 )

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

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

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

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

399

400 ;(defvar yahtml-struct-name-regexp

402 (defvar yahtml-struct-name-regexp

403 (concat

404 "\\<\\("

405 (mapconcat (function (lambda (x) (car x))) yahtml-typeface-table "\\|")

406 "\\)\\b")

407 "Regexp of structure beginning.")

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

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

410

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

412 (cond

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

414 buffer-file-name)

415 (let ((dir default-directory)

416 charset af ext (ldir "")

417 (case-fold-search t)

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

419 (setq ext (file-name-nondirectory buffer-file-name)

420 ext (substring ext (string-match "\\.[a-z0-9]+$" ext)))

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

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

423 (while (and dir

424 (not (string= dir ldir))

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

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

427 (if (file-exists-p af)

428 (save-excursion

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

430 (save-excursion

431 (goto-char (point-min))

432 (if (re-search-forward ;search the charset for same extension

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

434 nil t)

435 (progn

436 (setq charset

437 (buffer-substring

438 (match-beginning 1) (match-end 1)))

439 (cond

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

441 (setq charset 2))

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

443 (setq charset 3))

444 ((string-match "shift_jis" charset)

445 (setq charset 1))

446 (t (setq charset nil)))

447 (setq dir ""))))

448 (kill-buffer (current-buffer))))

449 (setq ldir dir

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

451 dir (file-name-directory dir)))

452 (if (featurep 'mule)

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

454 charset

455 ))

456 (t nil))

457 )

458

459 (defun yahtml-mode ()

460 (interactive)

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

462 (cond

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

464 (setq buffer-file-coding-system coding))

465 ((featurep 'mule)

466 (set-file-coding-system coding))

467 ((boundp 'NEMACS)

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

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

470 (setq major-mode 'yahtml-mode

471 mode-name "yahtml")

472 (mapcar

473 (function (lambda (x)

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

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

476 (boundp (cdr x)))

477 (symbol-value (cdr x))

478 (cdr x)))))

479 '((YaTeX-ec . "")

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

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

482 (YaTeX-struct-name-regexp . yahtml-struct-name-regexp)

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

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

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

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

487 (paragraph-start . yahtml-paragraph-start)

488 (paragraph-separate . yahtml-paragraph-separate)

489 (comment-start . "")

490 (comment-start-skip . comment-start)

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

492

493 (set-syntax-table yahtml-syntax-table)

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

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

496 (yahtml-css-scan-styles)

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

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

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

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

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

502

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

504 (cond

505 ((featurep 'xemacs)

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

507 (set keymap nil)

508 (mapcar

509 (function

510 (lambda (bind)

511 (setq bind (cdr bind))

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

513 (setcar (cdr bind) 'progn))

514 (if (stringp (car (cdr bind)))

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

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

517 (symbol-value keymap))))))

518 bindlist)

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

520 (t

521 (mapcar

522 (function

523 (lambda (bind)

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

525 bindlist))))

526

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

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

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

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

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

532

533 ;;; Variables for mosaic url history

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

535 (defvar yahtml-urls-private nil)

536 (defvar yahtml-urls-local nil)

537

538 (cond

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

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

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

542 (YaTeX-define-menu

543 'yahtml-menu-map-sectioning

544 (nreverse

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

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

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

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

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

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

551 )))

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

553 (YaTeX-define-menu

554 'yahtml-menu-map-logical

555 (nreverse

556 '((em "Embolden" .

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

558 (dfn "Define a word" .

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

560 (cite "Citation" .

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

562 (code "Code" .

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

564 (kbd "Keyboard" .

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

566 (samp "Sample display" .

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

568 (strong "Strong" .

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

570 (VAR "Variable notation" .

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

572 )))

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

574 (YaTeX-define-menu

575 'yahtml-menu-map-typeface

576 (nreverse

577 '((b "Bold" .

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

579 (i "Italic" .

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

581 (tt "Typewriter" .

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

583 (u "Underlined" .

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

585 )))

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

587 (YaTeX-define-menu

588 'yahtml-menu-map-listing

589 (nreverse

590 '((ul "Unordered" .

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

592 (ol "Ordered" .

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

594 (dl "Definition" .

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

596 )))

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

598 (YaTeX-define-menu

599 'yahtml-menu-map-item

600 (nreverse

601 '((li "Simple item" .

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

603 (dt "Define term" .

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

605 (dd "Description of term" .

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

607 )))

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

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

610 (let ((keys (where-is-internal 'fill-paragraph global-map)))

611 (while keys

612 (define-key yahtml-mode-map (car keys) 'yahtml-fill-paragraph)

613 (setq keys (cdr keys))))

614 (YaTeX-define-menu

615 'yahtml-menu-map

616 (nreverse

617 (list

618 (cons (list 'sect "Sectioning")

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

620 (cons (list 'list "Listing")

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

622 (cons (list 'item "Item")

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

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

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

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

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

628 )))

629 (if (featurep 'xemacs)

630 (add-hook 'yahtml-mode-hook

631 '(lambda ()

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

633 (progn

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

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

636 ))

637

638 ;;; ----------- Completion ----------

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

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

641 "Insert <cmd> ... </cmd>."

642 (interactive "P")

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

644 (cmd

645 (or env

646 (YaTeX-cplread-with-learning

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

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

649 (bolp (save-excursion

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

651 (cc (current-column)))

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

653 (setq yahtml-last-begend

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

655 yahtml-last-begend))

656 (setq cmd yahtml-last-begend)

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

658 (if region

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

660 ;; to enable continuous regioning by another environment

661 (let ((beg (region-beginning))

662 (end (region-end))

663 (addin (yahtml-addin cmd)))

664 (save-excursion

665 (goto-char end)

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

667 (goto-char beg)

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

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

670 (save-excursion

671 (insert "\n")

672 (indent-to-column cc)

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

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

675 (newline)

676 (yahtml-intelligent-newline nil))

677 (yahtml-indent-line))))

678

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

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

681 (interactive)

682 (yahtml-insert-begend t))

683

684

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

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

687 (interactive)

688 (or form

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

690 (setq form

691 (YaTeX-cplread-with-learning

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

693 'yahtml-form-table 'yahtml-user-form-table

694 'yahtml-tmp-form-table))))

695 (let ((p (point)) q)

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

697 (setq yahtml-last-form form)

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

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

700 ;;(indent-relative-maybe)

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

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

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

704

705 ;;; ---------- Add-in ----------

706 (defun yahtml-addin (form)

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

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

709 (concat

710 (if (setq a (assoc form yahtml-css-class-alist))

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

712 "class" (completing-read "class: " (cdr a))))

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

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

715 (string< "" s))

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

717 ""))))

718

719

720 (defvar yahtml-completing-buffer nil)

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

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

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

724 (let (list end)

725 (save-excursion

726 (set-buffer yahtml-completing-buffer)

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

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

729 (save-excursion

730 (goto-char (point-min))

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

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

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

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

735 (setq end (match-end 0))

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

737 (yahtml-on-assignment-p)

738 (progn

739 (goto-char end)

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

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

742 (setq list (cons

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

744 list))))

745 list)))

746 )

747

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

749 (if yahtml-url-completion-map nil

750 (setq yahtml-url-completion-map

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

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

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

754 )

755

756 (defun yahtml-complete-url ()

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

758 (interactive)

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

760 (setq initial (buffer-string))

761 (cond

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

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

764 listfunc (list 'lambda nil

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

766 beg (point-min)))

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

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

769 (progn

770 (setq path (substring initial 0 beg))

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

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

773 (setq initial (substring initial beg))

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

775 cmpl (try-completion initial labels)

776 listfunc (list 'lambda ()

777 (list 'all-completions

778 initial (list 'quote labels)))

779 beg (+ (point-min) beg)))

780 (t

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

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

783 initial))

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

785 file (file-name-nondirectory path)

786 initial file

787 cmpl (file-name-completion file dir)

788 listfunc (list 'lambda nil

789 (list 'file-name-all-completions

790 file dir))

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

792 (cond

793 ((stringp cmpl)

794 (if (string= initial cmpl)

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

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

797 (princ

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

799 (delete-region (point) beg)

800 (insert cmpl)))

801 ((null cmpl)

802 (ding))

803 ((eq t cmpl)

804 (save-excursion

805 (unwind-protect

806 (progn

807 (goto-char p)

808 (insert " [Sole completion]"))

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

810

811 (defvar yahtml-escape-chars 'ask

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

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

814 at each reserved chars.")

815

816 ;

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

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

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

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

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

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

823 ;

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

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

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

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

828 (defvar yahtml-unsafe-chars-regexp

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

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

831 ;

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

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

834 ;

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

836 ; "$" | ","

837 (defvar yahtml-unreserved-chars-regexp

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

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

840 Not used yet.")

841

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

843 "Translate reserved chars to URL encoded string."

844 (let ((p 0) (target "")

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

846 (cond

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

848 (t

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

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

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

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

853 (setq target (concat target

854 (substring str 0 p)

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

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

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

858 (concat target str)))))

859

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

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

862 (interactive "r")

863 (save-excursion

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

865 (goto-char beg)

866 (while (and (< (point) e)

867 (re-search-forward

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

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

870 (sit-for 0)

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

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

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

874 ; (unwind-protect

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

876 ; (save-excursion

877 ; (backward-char 1)

878 ; (delete-backward-char 4))

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

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

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

882 (progn

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

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

885 (set-marker e nil))))

886 ;; ab%defgls/.|

887

888 (defun yahtml:a ()

889 "Add-in function for <a>"

890 (let ((href ""))

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

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

893 href (yahtml-escape-chars-string

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

895 (prog1

896 (concat (yahtml-make-optional-argument

897 "href" href)

898 (yahtml-make-optional-argument

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

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

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

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

903 (YaTeX-update-table

904 (list href)

905 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

906 )))

907

908 (defvar yahtml-parameters-completion-alist

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

910 ("src" . file)

911 ("method" ("POST") ("GET"))

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

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

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

915

916 (defvar yahtml-link-types-alist

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

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

919 ("subsection") ("appendix") ("help") ("bookmark")))

920

921 (defvar yahtml-content-types-alist

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

923 ("text/sgml") ("text/xml")

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

925 ("image/jpeg") ("image/gif") ("image/tiff") ("video/mpeg"))

926 "Alist of content-types")

927

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

929 (let* ((alist

930 (cdr-safe (assoc (downcase par)

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

932 (prompt (concat par ": "))

933 v)

934 (cond

935 ((eq alist 'file)

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

937 ((symbolp alist)

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

939 (alist

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

941 (t

942 (read-string prompt default)))))

943

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

945 "Make optional argument string."

946 (if (string= "" arg)

947 ""

948 (concat " "

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

950 "=\"" arg "\"")))

951

952 (defun yahtml:body ()

953 "Add-in function for <body>"

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

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

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

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

958 (concat

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

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

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

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

963

964

965 (defun yahtml:img ()

966 "Add-in function for <img>"

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

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

969 (alt (yahtml-read-parameter "alt"))

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

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

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

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

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

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

976

977 (defun yahtml:form ()

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

979 (concat

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

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

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

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

984 ))

985

986 (defun yahtml:select ()

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

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

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

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

991

992 (defun yahtml:ol ()

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

994 (defun yahtml:ul ()

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

996 (defun yahtml:dl ()

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

998 (defun yahtml:dt ()

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

1000

1001 (defun yahtml:p ()

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

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

1004 ))

1005

1006 (defvar yahtml-input-types

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

1008 ("reset") ("image") ("hidden") ("file")))

1009

1010 (defun yahtml:input ()

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

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

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

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

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

1016 yahtml-input-types nil t)

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

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

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

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

1021 (concat

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

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

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

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

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

1027 )))

1028

1029 (defun yahtml:textarea ()

1030 "Add-in function for `textarea'"

1031 (interactive)

1032 (let (name rows cols)

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

1034 cols (read-string "Columns: ")

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

1036 (concat

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

1038 "\"" name "\"")

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

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

1041

1042 (defun yahtml:table ()

1043 "Add-in function for `table'"

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

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

1046 (concat

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

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

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

1050 (defun yahtml:caption ()

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

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

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

1054

1055 (defun yahtml:font ()

1056 "Add-in function for `font'"

1057 (concat

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

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

1060

1061 (defun yahtml:style ()

1062 "Add-in function for `style'"

1063 (yahtml-make-optional-argument

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

1065

1066 (defun yahtml:tr ()

1067 "Add-in function for `tr'"

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

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

1070 "")

1071

1072 (defun yahtml:link ()

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

1074 (let (rel rev type href)

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

1076 (cond

1077 ((equal rel "")

1078 (concat (yahtml-make-optional-argument

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

1080 (yahtml-make-optional-argument

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

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

1083 )))

1084 ((string-match "stylesheet" rel)

1085 (concat

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

1087 (yahtml-make-optional-argument

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

1089 (progn

1090 (setq href

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

1092 (if (string< "" href)

1093 (progn

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

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

1096 (setq yahtml-css-class-alist

1097 (yahtml-css-collect-classes-file

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

1099 (message "")

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

1101 (t ;;??

1102 ))))

1103

1104 ;;; ---------- Simple tag ----------

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

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

1107 (interactive "P")

1108 (or tag

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

1110 (setq tag

1111 (YaTeX-cplread-with-learning

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

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

1114 'yahtml-typeface-table 'yahtml-user-typeface-table

1115 'yahtml-tmp-typeface-table))))

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

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

1118 (setq yahtml-last-typeface-cmd tag

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

1120 (if region-mode

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

1122 (save-excursion

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

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

1125 (exchange-point-and-mark)

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

1127 (message "No mark set now"))

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

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

1130

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

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

1133 (interactive)

1134 (yahtml-insert-tag t tag))

1135

1136

1137 (defun yahtml-insert-single (cmd)

1138 "Insert <CMD>."

1139 (interactive

1140 (list

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

1142 (YaTeX-cplread-with-learning

1143 (format "Command%s: "

1144 (if yahtml-last-single-cmd

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

1146 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1149 (setq yahtml-last-single-cmd

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

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

1152 yahtml-last-single-cmd))

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

1154

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

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

1157 (interactive "P")

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

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

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

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

1162

1163 ;;; ---------- Jump ----------

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

1165 "Check if point is on href clause."

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

1167 (save-excursion

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

1169 (save-excursion

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

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

1172 (setq e (point)))

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

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

1175 (search-forward "href" e t)

1176 (search-forward "=" e t)

1177 (progn

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

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

1180 (< p (match-end 0))

1181 (YaTeX-match-string 1)

1182 ))))

1183

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

1185 (cond

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

1187 (set-process-buffer proc nil))

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

1189 (let ((cb (current-buffer)))

1190 (set-buffer (process-buffer proc))

1191 (goto-char (point-min))

1192 (if (search-forward "not running" nil t)

1193 (progn

1194 (message "Starting netscape...")

1195 (start-process

1196 "browser" (process-buffer proc)

1197 shell-file-name yahtml-shell-command-option

1198 (format "%s \"%s\"" yahtml-www-browser

1199 (get 'yahtml-netscape-sentinel 'url)))

1200 (message "Starting netscape...Done")))

1201 (set-buffer cb)))))

1202

1203 (defvar yahtml-browser-process nil)

1204

1205 (defun yahtml-browse-html (href)

1206 "Call WWW Browser to see HREF."

1207 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1208 (cond

1209 ((string-match "^start\\>" yahtml-www-browser)

1210 (if (get-buffer pb)

1211 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1212 (put 'yahtml-netscape-sentinel 'url href)

1213 (set-process-sentinel

1214 (setq yahtml-browser-process

1215 (start-process

1216 "browser" pb shell-file-name yahtml-shell-command-option

1217 (format "%s \"%s\"" yahtml-www-browser href)))

1218 'yahtml-netscape-sentinel))

1219 ((and (string-match "[Nn]etscape" yahtml-www-browser)

1220 (not (eq system-type 'windows-nt)))

1221 (if (get-buffer pb)

1222 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1223 (put 'yahtml-netscape-sentinel 'url href)

1224 (set-process-sentinel

1225 (setq yahtml-browser-process

1226 (start-process

1227 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1228 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1229 'yahtml-netscape-sentinel))

1230 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1231 (w3-fetch href))

1232 ((stringp yahtml-www-browser)

1233 (if (and yahtml-browser-process

1234 (eq (process-status yahtml-browser-process) 'run))

1235 (message "%s is already running" yahtml-www-browser)

1236 (setq yahtml-browser-process

1237 (start-process

1238 "browser" "* WWW Browser *"

1239 shell-file-name yahtml-shell-command-option

1240 (format "%s \"%s\"" yahtml-www-browser href)))))

1241 (t

1242 (message "Sorry, jump across http is not supported.")))))

1243

1244 (defun yahtml-goto-corresponding-href (&optional other)

1245 "Go to corresponding name."

1246 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1247 (if href

1248 (cond

1249 ((string-match "^\$ht\\|f\$tp:" href)

1250 (yahtml-browse-html href))

1251 (t (setq file (substring href 0 (string-match "#" href)))

1252 (if (string-match "#" href)

1253 (setq name (substring href (1+ (string-match "#" href)))))

1254 (if (string< "" file)

1255 (progn

1256 (if (string-match "/$" file)

1257 (setq file (concat file yahtml-directory-index)))

1258 (if (string-match "^/" file)

1259 (setq file (yahtml-url-to-path file)))

1260 (if other (YaTeX-switch-to-buffer-other-window file)

1261 (YaTeX-switch-to-buffer file))

1262 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1263 (if name

1264 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1265 t)))))

1266

1267 (defun yahtml-jump-to-name (name)

1268 "Jump to html's named tag."

1269 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1270 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1271 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1272 (message "Named tag `%s' not found" (substring href 1))))

1273

1274 (defun yahtml-on-begend-p (&optional p)

1275 "Check if point is on begend clause."

1276 (let ((p (or p (point))) cmd (case-fold-search t))

1277 (save-excursion

1278 (goto-char p)

1279 (if (equal (char-after (point)) ?<) (forward-char 1))

1280 (if (and (re-search-backward "<" nil t)

1281 (looking-at

1282 (concat "<\$/?" yahtml-struct-name-regexp "\$\\b"))

1283 (condition-case nil

1284 (forward-list 1)

1285 (error nil))

1286 (< p (point)))

1287 (YaTeX-match-string 1)))))

1288

1289 (defun yahtml-goto-corresponding-begend (&optional noerr)

1290 "Go to corresponding opening/closing tag.

1291 Optional argument NOERR causes no error for unballanced tag."

1292 (let ((cmd (yahtml-on-begend-p)) m0

1293 (p (point)) (case-fold-search t) func str (nest 0))

1294 (cond

1295 (cmd

1296 (setq m0 (match-beginning 0))

1297 (if (= (aref cmd 0) ?/) ;on </cmd> line

1298 (setq cmd (substring cmd 1)

1299 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1300 func 're-search-backward)

1301 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1302 func 're-search-forward))

1303 (while (and (>= nest 0) (funcall func str nil t))

1304 (if (equal m0 (match-beginning 0))

1305 nil

1306 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1307 (if (< nest 0)

1308 (goto-char (match-beginning 0))

1309 (funcall

1310 (if noerr 'message 'error)

1311 "Corresponding tag of `%s' not found." cmd)

1312 (goto-char p)

1313 nil))

1314 (t nil))))

1315

1316 (defun yahtml-current-tag ()

1317 "Return the current tag name."

1318 (save-excursion

1319 (let ((p (point)) b tag)

1320 (or (bobp)

1321 (looking-at "<")

1322 (progn (skip-chars-backward "^<") (forward-char -1)))

1323 (setq b (point))

1324 (skip-chars-forward "<")

1325 (setq tag (buffer-substring

1326 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1327 (goto-char b)

1328 (forward-list 1)

1329 (and (< p (point)) tag))))

1330

1331

1332 (defun yahtml-goto-corresponding-img ()

1333 "View image on point"

1334 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1335 (if (and tag

1336 (string-match "img" tag)

1337 (save-excursion

1338 (re-search-backward "<\\s *img" nil t)

1339 (re-search-forward "src=\"?\$[^\"> ]+\$\"?")

1340 (match-beginning 1)

1341 (setq image

1342 (buffer-substring (match-beginning 1) (match-end 1)))))

1343 (progn

1344 (message "Invoking %s %s..." yahtml-image-viewer image)

1345 (start-process

1346 "Viewer" " * Image Viewer *"

1347 shell-file-name yahtml-shell-command-option ;"-c"

1348 (concat yahtml-image-viewer " " image))

1349 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1350

1351 (defun yahtml-get-attrvalue (attr)

1352 "Extract current tag's attribute value from buffer."

1353 (let (e (case-fold-search t))

1354 (save-excursion

1355 (or (looking-at "<")

1356 (progn (skip-chars-backward "^<") (backward-char 1)))

1357 (setq e (save-excursion (forward-list 1) (point)))

1358 (if (and

1359 (re-search-forward (concat "\\b" attr "\\b") e t)

1360 (progn (skip-chars-forward " \t\n=")

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

1362 (YaTeX-match-string 1)))))

1363

1364 (defun yahtml-goto-corresponding-source (&optional other)

1365 "Goto applet's source."

1366 (let ((env (yahtml-current-tag)) s (p (point)))

1367 (cond

1368 ((string-match "applet" env)

1369 (if (setq s (yahtml-get-attrvalue "code"))

1370 (progn

1371 (setq s (YaTeX-match-string 1)

1372 s (concat

1373 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1374 ".java"))

1375 (if other (YaTeX-switch-to-buffer-other-window s)

1376 (YaTeX-switch-to-buffer s))

1377 s) ;return source file name

1378 (message "No applet source specified")

1379 (sit-for 1)

1380 nil))

1381 ((string-match "!--#include" env)

1382 (cond

1383 ((setq s (yahtml-get-attrvalue "file")) ;

1384 (if other (YaTeX-switch-to-buffer-other-window s)

1385 (YaTeX-switch-to-buffer s))

1386 s)

1387 ((setq s (yahtml-get-attrvalue "virtual"));

1388 (setq s (yahtml-url-to-path s))

1389 (if other (YaTeX-switch-to-buffer-other-window s)

1390 (YaTeX-switch-to-buffer s))

1391 s)))

1392 ((and (string-match "!--#exec" env)

1393 (setq s (yahtml-get-attrvalue "cmd")))

1394 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1395 (let ((b " *yahtmltmp*")) ;peek a little

1396 (unwind-protect

1397 (progn

1398 (set-buffer (get-buffer-create b))

1399 (insert-file-contents s nil 0 100)

1400 (if (looking-at "#!")

1401 (if other (YaTeX-switch-to-buffer-other-window s)

1402 (YaTeX-switch-to-buffer s))))

1403 (kill-buffer (get-buffer b)))

1404 (get-file-buffer s))))))

1405

1406 (defun yahtml-goto-corresponding-* (&optional other)

1407 "Go to corresponding object."

1408 (interactive)

1409 (cond

1410 ((yahtml-goto-corresponding-href other))

1411 ((yahtml-goto-corresponding-img))

1412 ((yahtml-goto-corresponding-begend))

1413 ((yahtml-goto-corresponding-source other))

1414 (t (message "I don't know where to go."))

1415 ))

1416

1417 (defun yahtml-goto-corresponding-*-other-window ()

1418 "Go to corresponding object."

1419 (interactive)

1420 (yahtml-goto-corresponding-* t))

1421

1422 (defun yahtml-visit-main ()

1423 "Go to parent file from where you visit current file."

1424 (interactive)

1425 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1426

1427 ;;; ---------- killing ----------

1428 (defun yahtml-kill-begend (&optional whole)

1429 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1430 (if tag

1431 (save-excursion

1432 (or (looking-at "<")

1433 (progn (skip-chars-backward "^<") (forward-char -1)))

1434 (setq p (point))

1435 (yahtml-goto-corresponding-begend)

1436 (or (looking-at "<")

1437 (progn (skip-chars-backward "^<") (forward-char -1)))

1438 (if (< (point) p) ;if on the opening tag

1439 (progn (setq q p p (point))

1440 (goto-char q))

1441 (setq q (point))) ;now q has end-line's (point)

1442 (if (not whole)

1443 (kill-region

1444 (progn (skip-chars-backward " \t")

1445 (if (setq bbolp (bolp)) (point) q))

1446 (progn (forward-list 1)

1447 (setq r (point))

1448 (skip-chars-forward " \t")

1449 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1450 (goto-char p)

1451 (skip-chars-backward " \t")

1452 (if (not whole)

1453 (progn

1454 (kill-append

1455 (buffer-substring

1456 (setq p (if (setq bbolp (bolp)) (point) p))

1457 (setq q (progn

1458 (forward-list 1)

1459 (setq r (point))

1460 (skip-chars-forward " \t")

1461 (if (and bbolp (eolp) (not (eobp)))

1462 (1+ (point))

1463 r))))

1464 t)

1465 (delete-region p q))

1466 (kill-region

1467 (if (bolp) (point) p)

1468 (progn (goto-char q)

1469 (forward-list 1)

1470 (setq r (point))

1471 (skip-chars-forward " \t")

1472 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1473 tag))))

1474

1475 (defun yahtml-kill-* (whole)

1476 "Kill current position's HTML tag (set)."

1477 (interactive "P")

1478 (cond

1479 ((yahtml-kill-begend whole))

1480 ))

1481

1482

1483 ;;; ---------- changing ----------

1484 (defun yahtml-on-assignment-p ()

1485 "Return if current point is on parameter assignment.

1486 If so, return parameter name, otherwise nil.

1487 This function should be able to treat white spaces in value, but not yet."

1488 (let ((p (point)))

1489 (save-excursion

1490 (put 'yahtml-on-assignment-p 'region nil)

1491 (skip-chars-backward "^ \t")

1492 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

1493 (< p (match-end 0))

1494 (>= p (1- (match-beginning 2)))

1495 (put 'yahtml-on-assignment-p 'region

1496 (cons (match-beginning 2) (match-end 2)))

1497 (YaTeX-match-string 1)))))

1498

1499 (defun yahtml-change-begend ()

1500 (let ((tag (yahtml-on-begend-p))

1501 (completion-ignore-case t)

1502 (case-fold-search t)

1503 (p (point)) (q (make-marker))

1504 (default (append yahtml-env-table yahtml-typeface-table))

1505 (user (append yahtml-user-env-table yahtml-user-typeface-table))

1506 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

1507 href b1 e1 attr new css)

1508 (cond

1509 (tag

1510 (cond

1511 ((and (string-match "^a$" tag)

1512 (save-excursion

1513 (and

1514 (re-search-backward "<a\\b" nil t)

1515 (progn

1516 (goto-char (match-end 0))

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

1518 (setq b1 (point))

1519 (search-forward ">" nil t))

1520 (setq e1 (match-beginning 0))

1521 (goto-char b1)

1522 (re-search-forward "href\\s *=" e1 t)

1523 (>= p (point))

1524 (progn

1525 (goto-char (match-end 0))

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

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

1528 (< p (match-end 0)))))

1529 (setq b1 (match-beginning 1) e1 (match-end 1)

1530 yahtml-completing-buffer (current-buffer)

1531 ;; yahtml-urls-local is buffer-local, so we must put

1532 ;; that into yahtml-urls here

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

1534 href (read-from-minibuffer

1535 "Change href to: " "" yahtml-url-completion-map))

1536 (if (string< "" href)

1537 (progn

1538 ;;(setq href ;??

1539 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

1540 (delete-region b1 e1)

1541 (goto-char b1)

1542 (insert href))))

1543 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

1544 (if (and (equal attr "class") ;treat "class" attribute specially

1545 (setq css (assoc tag yahtml-css-class-alist)))

1546 (setq new (yahtml-read-parameter ;should be made generic?

1547 attr nil (list (cons "class" (cdr css)))))

1548 ;;other than "class", read parameter normally

1549 (setq new (yahtml-read-parameter attr)))

1550 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

1551 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

1552 (insert new))

1553 (t

1554 (save-excursion

1555 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

1556 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

1557 (skip-chars-forward "^A-Za-z")

1558 (set-marker q (point))

1559 (setq p (point))

1560 (yahtml-goto-corresponding-begend)

1561 (or (= (char-after (point)) ?<)

1562 (skip-chars-backward "^<"))

1563 (skip-chars-forward "^A-Za-z")

1564 (if (= (char-after (1- (point))) ?/)

1565 (progn

1566 (set-marker q (point))

1567 (goto-char p)))

1568 (setq tag (let ((completion-ignore-case t))

1569 (YaTeX-cplread-with-learning

1570 (format "Change `%s' to(default %s): "

1571 tag yahtml-last-begend)

1572 'default 'user 'tmp)))

1573 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1574 (if (string= "" tag) (setq tag yahtml-last-begend))

1575 (setq yahtml-last-begend

1576 (or (cdr (assoc tag yahtml-env-table)) tag)

1577 tag yahtml-last-begend)

1578 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

1579 (insert (format "%s%s" tag (yahtml-addin tag)))

1580 (goto-char q)

1581 (set-marker q nil)

1582 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1583 (insert tag))))

1584 t))))

1585

1586 (defun yahtml-change-command ()

1587 (let ((p (point)) (case-fold-search t) cmd par new

1588 (beg (make-marker)) (end (make-marker)))

1589 (skip-chars-backward "^<")

1590 (if (and

1591 (looking-at yahtml-command-regexp)

1592 (progn

1593 (set-marker beg (match-beginning 0))

1594 (set-marker end (match-end 0))

1595 t) ;for further work

1596 (progn

1597 (forward-char -1)

1598 (condition-case nil

1599 (forward-list 1)

1600 (error nil))

1601 (< p (point))))

1602 (progn

1603 (goto-char p)

1604 (if (setq par (yahtml-on-assignment-p))

1605 (progn

1606 (setq new (yahtml-read-parameter par))

1607 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

1608 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

1609 (setq new

1610 (YaTeX-cplread-with-learning

1611 "Change form to: "

1612 'yahtml-form-table 'yahtml-user-form-table

1613 'yahtml-tmp-form-table)))

1614 (delete-region beg end)

1615 (goto-char beg)

1616 (set-marker beg nil)

1617 (set-marker end nil)

1618 (insert new)

1619 t)

1620 (goto-char p)

1621 nil)))

1622

1623 (defun yahtml-change-* ()

1624 "Change current position's HTML tag (set)."

1625 (interactive)

1626 (cond

1627 ((yahtml-change-begend))

1628 ((yahtml-change-command))

1629 ))

1630

1631 ;;; ---------- commenting ----------

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

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

1634

1635 (defun yahtml-comment-region (&optional uncom)

1636 "Comment out region or environment."

1637 (interactive)

1638 (let ((e (make-marker)) beg p)

1639 (cond

1640 ((marker-position (set-marker e (yahtml-on-begend-p)))

1641 (save-excursion

1642 (setq p (point))

1643 (if (string-match "^/" e)

1644 (setq beg (progn (forward-line 1) (point)))

1645 (setq beg (progn (beginning-of-line) (point))))

1646 (goto-char p)

1647 (yahtml-goto-corresponding-begend)

1648 (if (string-match "^/" e)

1649 (beginning-of-line)

1650 (forward-line 1))

1651 (set-marker e (point))

1652 ;(comment-region beg (point) (if uncom (list 4)))

1653 ))

1654 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

1655 (setq beg (region-beginning))

1656 (set-marker e (region-end))))

1657 (if yahtml-translate-hyphens-when-comment-region

1658 (let ((yahtml-entity-reference-chars-alist-default nil)

1659 (yahtml-entity-reference-chars-alist '((?- . "#45")))

1660 yahtml-entity-reference-chars-regexp

1661 yahtml-entity-reference-chars-reverse-regexp)

1662 (yahtml-entity-reference-chars-setup)

1663 (funcall

1664 (if uncom 'yahtml-translate-reverse-region

1665 'yahtml-translate-region)

1666 beg e)))

1667 (comment-region beg e (if uncom (list 4)))

1668 (set-marker e nil)))

1669

1670 (defun yahtml-uncomment-region ()

1671 (interactive)

1672 (yahtml-comment-region t))

1673

1674 ;;; ---------- translate to entity references ----------

1675 (defvar yahtml-entity-reference-chars-alist-default

1676 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

1677 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

1678 "Default translation table from character to entity reference")

1679 (defvar yahtml-entity-reference-chars-alist nil

1680 "*Translation table from character to entity reference")

1681 (defvar yahtml-entity-reference-chars-regexp nil)

1682 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

1683

1684 (defun yahtml-entity-reference-chars-setup ()

1685 (let ((list (append yahtml-entity-reference-chars-alist-default

1686 yahtml-entity-reference-chars-alist)))

1687 (setq yahtml-entity-reference-chars-regexp "["

1688 yahtml-entity-reference-chars-reverse-regexp "&\\(")

1689 (while list

1690 (setq yahtml-entity-reference-chars-regexp

1691 (concat yahtml-entity-reference-chars-regexp

1692 (char-to-string (car (car list))))

1693 yahtml-entity-reference-chars-reverse-regexp

1694 (concat yahtml-entity-reference-chars-reverse-regexp

1695 (cdr (car list))

1696 (if (cdr list) "\\|")))

1697 (setq list (cdr list)))

1698 (setq yahtml-entity-reference-chars-regexp

1699 (concat yahtml-entity-reference-chars-regexp "]")

1700 yahtml-entity-reference-chars-reverse-regexp

1701 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

1702

1703 (yahtml-entity-reference-chars-setup)

1704

1705 (defun yahtml-translate-region (beg end)

1706 "Translate inhibited literals."

1707 (interactive "r")

1708 (save-excursion

1709 (save-restriction

1710 (narrow-to-region beg end)

1711 (let ((ct (append yahtml-entity-reference-chars-alist

1712 yahtml-entity-reference-chars-alist-default)))

1713 (goto-char beg)

1714 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

1715 ;(setq c (preceding-char))

1716 (replace-match

1717 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

1718

1719 (defun yahtml-translate-reverse-region (beg end)

1720 "Translate entity references to literals."

1721 (interactive "r")

1722 (save-excursion

1723 (save-restriction

1724 (narrow-to-region beg end)

1725 (let ((ct (append yahtml-entity-reference-chars-alist

1726 yahtml-entity-reference-chars-alist-default))

1727 ec)

1728 (goto-char beg)

1729 (while (re-search-forward

1730 yahtml-entity-reference-chars-reverse-regexp nil t)

1731 ;(setq c (preceding-char))

1732 (setq ec (YaTeX-match-string 1))

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

1734 (insert (car (YaTeX-rassoc ec ct))))))))

1735

1736 (defun yahtml-inner-environment-but (exclude &optional quick)

1737 "Return the inner environment but matches with EXCLUDE tag."

1738 (let (e (case-fold-search t))

1739 (save-excursion

1740 (while (and (setq e (YaTeX-inner-environment quick))

1741 (string-match exclude e))

1742 (goto-char (get 'YaTeX-inner-environment 'point))))

1743 e))

1744

1745 ;;; ---------- filling ----------

1746 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

1747 (defun yahtml-move-to-column (col &optional force)

1748 (beginning-of-line)

1749 (let ((ccol 0))

1750 (while (and (> col ccol) (not (eolp)))

1751 (if (eq (following-char) ?\<)

1752 (progn

1753 (while (and (not (eq (following-char) ?\>))

1754 (not (eolp)))

1755 (forward-char))

1756 (or (eolp) (forward-char)))

1757 (or (eolp) (forward-char))

1758 (if (eq (preceding-char) ?\t)

1759 (let ((wd (- 8 (% (+ ccol 8) 8))))

1760 (if (and force (< col (+ ccol wd)))

1761 (progn

1762 (backward-char 1)

1763 (insert-char ?\ (- col ccol))

1764 (setq ccol col))

1765 (setq ccol (+ ccol wd))))

1766 (setq ccol (1+ ccol)))

1767 (if (and YaTeX-japan

1768 (or

1769 (and (fboundp 'char-category)

1770 (string-match "[chj]" (char-category (preceding-char))))

1771 (and (fboundp 'char-charset)

1772 (not (eq (char-charset (preceding-char)) 'ascii)))))

1773 (setq ccol (1+ ccol)))))

1774 (if (and force (> col ccol))

1775 (progn

1776 (insert-char ?\ (- col ccol))

1777 col)

1778 ccol)))

1779

1780 (defun yahtml-fill-paragraph (arg)

1781 (interactive "P")

1782 (let*((case-fold-search t) (p (point)) fill-prefix

1783 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

1784 indent

1785 (startp (get 'YaTeX-inner-environment 'point))

1786 (prep (string-match "^pre$" e))

1787 (ps1 (if prep (default-value 'paragraph-start)

1788 paragraph-start))

1789 (ps2 (if prep (concat (default-value 'paragraph-start)

1790 "$\\|^\\s *</?pre>")

1791 paragraph-start)))

1792 (save-excursion

1793 (unwind-protect

1794 (progn

1795 (if prep

1796 (fset 'move-to-column 'yahtml-move-to-column))

1797 (save-excursion

1798 (beginning-of-line)

1799 (indent-to-column (yahtml-this-indent))

1800 (setq fill-prefix

1801 (buffer-substring (point) (point-beginning-of-line)))

1802 (delete-region (point) (point-beginning-of-line)))

1803 (fill-region-as-paragraph

1804 (progn (re-search-backward paragraph-start nil t)

1805 (or (save-excursion

1806 (goto-char (match-beginning 0))

1807 (if (looking-at "<")

1808 (forward-list)

1809 (goto-char (match-end 0))

1810 (skip-chars-forward " \t>"))

1811 (if (looking-at "[ \t]*$")

1812 (progn (forward-line 1) (point))))

1813 (point)))

1814 (progn (goto-char p)

1815 (re-search-forward ps2 nil t)

1816 (match-beginning 0))))

1817 (fset 'move-to-column yahtml-saved-move-to-column)))))

1818

1819 ;(defun yahtml-indent-new-commnet-line ()

1820 ; (unwind-protect

1821 ; (progn

1822 ; (fset 'move-to-column 'yahtml-move-to-column)

1823 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

1824 ; (fset 'move-to-column yahtml-saved-move-to-column)))

1825

1826 ;;;

1827 ;;; ---------- indentation ----------

1828 ;;;

1829 (defun yahtml-indent-line ()

1830 "Indent a line (faster wrapper)"

1831 (interactive)

1832 (let (indent)

1833 (if (and (save-excursion

1834 (beginning-of-line) (skip-chars-forward "\t ")

1835 (not (looking-at "<")))

1836 (save-excursion

1837 (forward-line -1)

1838 (while (and (not (bobp)) (looking-at "^\\s *$"))

1839 (forward-line -1))

1840 (skip-chars-forward "\t ")

1841 (setq indent (current-column))

1842 (not (looking-at "<"))))

1843 (progn

1844 (save-excursion

1845 (beginning-of-line)

1846 (skip-chars-forward " \t")

1847 (or (= (current-column) indent)

1848 (YaTeX-reindent indent)))

1849 (and (bolp) (skip-chars-forward " \t")))

1850 (yahtml-indent-line-real))))

1851

1852 (defun yahtml-this-indent ()

1854 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

1855 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

1856 inenv p col peol (case-fold-search t))

1857 (save-excursion

1858 (beginning-of-line)

1859 (setq inenv (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

1860 "html")

1861 col (get 'YaTeX-inner-environment 'indent)

1862 p (get 'YaTeX-inner-environment 'point)

1863 op nil))

1864 (save-excursion

1865 (cond

1866 ((string-match envs inenv)

1867 (save-excursion

1868 (beginning-of-line)

1869 (skip-chars-forward " \t")

1870 (cond ;lookup current line's tag

1871 ((looking-at (concat "</\$" envs "\$>"))

1872 col)

1873 ((looking-at itms)

1874 (+ col yahtml-environment-indent))

1875 ((and yahtml-hate-too-deep-indentation

1876 (looking-at (concat "<\$" envs "\$")))

1877 (+ col (* 2 yahtml-environment-indent)))

1878 ((and (< p (point))

1879 (string-match itemizing-envs inenv)

1880 (save-excursion

1881 (and

1882 (setq op (point))

1883 (goto-char p)

1884 (re-search-forward itms op t)

1885 (progn

1886 (skip-chars-forward "^>")

1887 (skip-chars-forward ">")

1888 (skip-chars-forward " \t")

1889 (setq col (if (looking-at "$")

1890 (+ col yahtml-environment-indent)

1891 (current-column)))))))

1892 col)

1893 (t

1894 (+ col yahtml-environment-indent)))))

1895 (t col)))))

1896

1897 (defun yahtml-indent-line-real ()

1898 "Indent current line."

1899 (interactive)

1900 (YaTeX-reindent (yahtml-this-indent))

1901 (if (bolp) (skip-chars-forward " \t"))

1902 (let (peol col)

1903 (if (and (setq inenv (yahtml-on-begend-p))

1904 (string-match

1905 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

1906 (save-excursion

1907 (setq peol (point-end-of-line))

1908 (or (= (char-after (point)) ?<)

1909 (progn (skip-chars-backward "^<") (forward-char -1)))

1910 (setq col (current-column))

1911 (if (and (yahtml-goto-corresponding-begend t)

1912 (> (point) peol)) ;if on the different line

1913 (YaTeX-reindent col))))))

1914

1915 ;(defun yahtml-fill-item ()

1916 ; "Fill item HTML version"

1917 ; (interactive)

1918 ; (let (inenv p fill-prefix peol (case-fold-search t))

1919 ; (setq inenv (or (YaTeX-inner-environment) "html")

1920 ; p (get 'YaTeX-inner-environment 'point))

1921 ; (cond

1922 ; ((string-match "^[uod]l" inenv)

1923 ; (save-excursion

1924 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

1925 ; (progn

1926 ; (goto-char (match-end 0))

1927 ; (setq col (current-column)))

1928 ; (error "No <li>, <dt>, <dd>")))

1929 ; (save-excursion

1930 ; (end-of-line)

1931 ; (setq peol (point))

1932 ; (newline)

1933 ; (indent-to-column col)

1934 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

1935 ; (delete-region (point) peol)

1936 ; (fill-region-as-paragraph

1937 ; (progn (re-search-backward paragraph-start nil t) (point))

1938 ; (progn (re-search-forward paragraph-start nil t 2)

1939 ; (match-beginning 0)))))

1940 ; (t nil))))

1941

1942 ;;;

1943 ;;; ---------- Lint and Browsing ----------

1944 ;;;

1945 (defun yahtml-browse-menu ()

1946 "Browsing menu"

1947 (interactive)

1948 (message "J)weblint p)Browse R)eload...")

1949 (let ((c (char-to-string (read-char))))

1950 (cond

1951 ((string-match "j" c)

1952 (yahtml-lint-buffer (current-buffer)))

1953 ((string-match "[bp]" c)

1954 (yahtml-browse-current-file))

1955 ((string-match "r" c)

1956 (yahtml-browse-reload)))))

1957

1958 (defvar yahtml-lint-buffer "*weblint*")

1959

1960 (defun yahtml-lint-buffer (buf)

1961 "Call lint on buffer BUF."

1962 (require 'yatexprc)

1963 (interactive "bCall lint on buffer: ")

1964 (setq buf (get-buffer buf))

1965 (YaTeX-save-buffers)

1966 (YaTeX-typeset

1967 (concat yahtml-lint-program " "

1968 (file-name-nondirectory (buffer-file-name buf)))

1969 yahtml-lint-buffer "lint" "lint"))

1970

1971 (defun yahtml-file-to-url (file)

1972 "Convert local unix file name to URL.

1973 If no matches found in yahtml-path-url-alist, return raw file name."

1974 (let ((list yahtml-path-url-alist) p url)

1975 (if (file-directory-p file)

1976 (setq file (expand-file-name yahtml-directory-index file))

1977 (setq file (expand-file-name file)))

1978 (if (string-match "^[A-Za-z]:/" file)

1979 (progn

1980 ;; (aset file 1 ?|) ;これは要らないらしい…

1981 (setq file (concat "///" file))))

1982 (while list

1983 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

1984 (setq url (cdr (car list))

1985 file (substring file (match-end 0))

1986 url (concat url file)

1987 list nil))

1988 (setq list (cdr list)))

1989 (or url (concat "file:" file))))

1990

1991 (defun yahtml-url-to-path (file &optional basedir)

1992 "Convert local URL name to unix file name."

1993 (let ((list yahtml-path-url-alist) url realpath docroot

1994 (dirsufp (string-match "/$" file)))

1995 (setq basedir (or basedir

1996 (file-name-directory

1997 (expand-file-name default-directory))))

1998 (cond

1999 ((string-match "^/" file)

2000 (while list

2001 (if (file-directory-p (car (car list)))

2002 (progn

2003 (setq url (cdr (car list)))

2004 (if (string-match "\$http://[^/]*\$/" url)

2005 (setq docroot (substring url (match-end 1)))

2006 (setq docroot url))

2007 (cond

2008 ((string-match (concat "^" (regexp-quote docroot)) file)

2009 (setq realpath

2010 (expand-file-name

2011 (substring

2012 file

2013 (if (= (aref file (1- (match-end 0))) ?/)

2014 (match-end 0) ; "/foo"

2015 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2016 (car (car list))))))

2017 (if realpath

2018 (progn (setq list nil)

2019 (if (and dirsufp (not (string-match "/$" realpath)))

2020 (setq realpath (concat realpath "/")))))))

2021 (setq list (cdr list)))

2022 realpath)

2023 (t file))))

2024

2025 (defun yahtml-browse-current-file ()

2026 "Call WWW browser on current file."

2027 (interactive)

2028 (basic-save-buffer)

2029 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2030

2031 (defun yahtml-browse-reload ()

2032 "Send `reload' event to netzscape."

2033 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2034 (cond

2035 ((string-match "[Nn]etscape" yahtml-www-browser)

2036 (if (get-buffer pb)

2037 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2038 ;;(or (get 'yahtml-netscape-sentinel 'url)

2039 ;; (error "Reload should be called after Browsing."))

2040 (put 'yahtml-netscape-sentinel 'url

2041 (yahtml-file-to-url (buffer-file-name)))

2042 (basic-save-buffer)

2043 (set-process-sentinel

2044 (setq yahtml-browser-process

2045 (start-process

2046 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2047 (format "%s -remote 'reload'" yahtml-www-browser)))

2048 'yahtml-netscape-sentinel))

2049 (t

2050 (message "Sorry, RELOAD is supported only for Netscape.")))))

2051

2052 ;;; ---------- Intelligent newline ----------

2053 (defun yahtml-intelligent-newline (arg)

2054 "Intelligent newline for HTML"

2055 (interactive "P")

2056 (let (env func)

2057 (end-of-line)

2058 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2059 "html")))

2060 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2061 (newline)

2062 (if (and env func (fboundp func))

2063 ;; if intelligent line function is defined, call that

2064 (funcall func)

2065 ;; else do the default action

2066 (if (string-match yahtml-p-prefered-env-regexp env)

2067 (yahtml-insert-p)))))

2068

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

2070 (defun yahtml-intelligent-newline-ul ()

2071 (interactive)

2072 (yahtml-insert-single "li")

2073 (or yahtml-faithful-to-htmllint (insert " "))

2074 (yahtml-indent-line))

2075

2076 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2077

2078 (defun yahtml-intelligent-newline-dl ()

2079 (interactive)

2080 (let ((case-fold-search t))

2081 (if (save-excursion

2082 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)>"

2083 (get 'YaTeX-inner-environment 'point) t))

2084 (cond

2085 ((match-beginning 2)

2086 (yahtml-insert-single "dd")

2087 (or yahtml-faithful-to-htmllint (insert " "))

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

2089 ((match-beginning 3)

2090 (yahtml-insert-single "dt")

2091 (or yahtml-faithful-to-htmllint (insert " "))

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

2093 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

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

2095 (yahtml-indent-line)

2096 (and (string-match yahtml-p-prefered-env-regexp "dl")

2097 (string-equal yahtml-last-single-cmd "dt")

2098 (yahtml-insert-p nil))))

2099

2100 (defun yahtml-intelligent-newline-select ()

2101 (interactive)

2102 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2103 (yahtml-indent-line))

2104

2105 ;;; ---------- Marking ----------

2106 (defun yahtml-mark-begend ()

2107 "Mark current tag"

2108 (interactive)

2109 (YaTeX-beginning-of-environment)

2110 (let ((p (point)))

2111 (save-excursion

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

2113 (if (bolp) (setq p (point))))

2114 (push-mark p t))

2115 (yahtml-goto-corresponding-begend)

2116 (forward-list 1)

2117 (if (eolp) (forward-char 1)))

2118

2119 ;;; ---------- complete marks ----------

2120 (defun yahtml-complete-mark ()

2121 "Complete &gt, &lt, &ampersand, and &quote."

2122 (interactive)

2123 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2124 (let ((c (read-char)))

2125 (setq c (if (or (< c ?0) (> c ?7))

2126 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2127 (- c ?1)))

2128 (if (or (< c 0) (> c 6))

2129 nil

2130 (insert (format "&%s;"

2131 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2132

2133

2134 ;;; ---------- jump to error line ----------

2135 (defvar yahtml-error-line-regexp

2136 "^\$.*\$(\$[0-9]+\$):"

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

2138 (defun yahtml-prev-error ()

2139 "Jump to previous error seeing lint buffer."

2140 (interactive)

2141 (or (get-buffer yahtml-lint-buffer)

2142 (error "No lint program ran."))

2143 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2144 (yahtml-jump-to-error-line t))

2145

2146 (defun yahtml-jump-to-error-line (&optional sit)

2147 (interactive "P")

2148 (let ((p (point)) (e (point-end-of-line)))

2149 (end-of-line)

2150 (if (re-search-backward yahtml-error-line-regexp nil t)

2151 (let ((f (YaTeX-match-string 1))

2152 (l (string-to-int (YaTeX-match-string 2))))

2153 (if sit (sit-for 1))

2154 (forward-line -1)

2155 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2156 (goto-line l))

2157 (message "No line number usage"))))

2158

2159 ;;; ---------- Style Sheet Support ----------

2160 (defvar yahtml-css-class-alist nil

2161 "Alist of elements vs. their classes")

2162

2163 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2164 (save-restriction

2165 (save-excursion

2166 (narrow-to-region beg end)

2167 (goto-char (point-min))

2168 (let ((alist initial) b e element class a

2169 (s1 (aref (syntax-table) ?\{ ))

2170 (s2 (aref (syntax-table) ?\} )))

2171 ;(modify-syntax-entry ?{ "(}")

2172 ;(modify-syntax-entry ?} "){")

2173 (setq b (point))

2174 (unwind-protect

2175 (while (search-forward "{" nil t)

2176 (setq e (point))

2177 (goto-char b)

2178 (while (re-search-forward ;ちょといい加減なREGEXP

2179 "\$[a-z][a-z0-9]*\$\\.\$[a-z][a-z0-9]*\$\\>" e t)

2180 (setq element (YaTeX-match-string 1)

2181 class (YaTeX-match-string 2))

2182 (if (setq a (assoc element alist))

2183 (or (assoc class (cdr a))

2184 (setcdr a (cons (list class) (cdr a))))

2185 (setq alist (cons (list element (list class)) alist))))

2186 (goto-char (1- e))

2187 ;(forward-list 1)

2188 (search-forward "}" nil t)

2189 (setq b (point)))

2190 (aset (syntax-table) ?\{ s1)

2191 (aset (syntax-table) ?} s2))

2192 alist))))

2193

2194 (defun yahtml-css-collect-classes-buffer (&optional initial)

2195 (interactive)

2196 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2197

2198 (defun yahtml-css-collect-classes-file (file &optional initial)

2199 (let ((hilit-auto-highlight nil) (cb (current-buffer)))

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

2201 (prog1

2202 (yahtml-css-collect-classes-buffer initial)

2203 (set-buffer cb))))

2204

2205 (defun yahtml-css-scan-styles ()

2206 (save-excursion

2207 (goto-char (point-min))

2208 (set (make-local-variable 'yahtml-css-class-alist) nil)

2209 (while (re-search-forward "<\$style\\|link\$" nil t)

2210 (let ((b (match-beginning 0))(tag (YaTeX-match-string 1)) e href alist)

2211 (cond

2212 ((string-match "style" tag)

2213 (goto-char b)

2214 (save-excursion (forward-list 1) (setq e (point)))

2215 (cond

2216 ((search-forward "text/css" e 1) ;css definition starts

2217 (setq alist

2218 (yahtml-css-collect-classes-region

2219 (point) (progn (search-forward "</style>") (point))

2220 alist)))))

2221 ((and (string-match "link" tag)

2222 (setq href (yahtml-get-attrvalue "href"))

2223 (file-exists-p (yahtml-url-to-path href)))

2224 (setq alist

2225 (yahtml-css-collect-classes-file

2226 (yahtml-url-to-path href) alist))))

2227 (setq yahtml-css-class-alist alist)))))

2228

2229 ;;; ---------- ----------

2230

2231 ;;;

2232 ;;hilit19

2233 ;;;

2234 (defvar yahtml-default-face-table

2235 '(

2236 (form black/ivory white/hex-442233 italic)

2237 ))

2238 (defvar yahtml-hilit-patterns-alist

2239 '(

2240 ;; comments

2241 ("" comment)

2242 ;; include&exec

2243 ("" include)

2244 ;; string

2245 (hilit-string-find ?\\ string)

2246 (yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2247 ("</?[uod]l>" 0 decl)

2248 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2249 ("<a\\s +href" "</a>" crossref)

2250 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2251 ))

2252

2253 (defun yahtml-hilit-region-tag (tag)

2254 "Return list of start/end point of <TAG> form."

2255 (if (re-search-forward (concat "<" tag ">") nil t)

2256 (let ((m0 (match-beginning 0)))

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

2258 (cons (point)

2259 (progn (re-search-forward (concat "</" tag ">") nil t)

2260 (match-beginning 0))))))

2261

2262 (defun yahtml-hilit-region-tag-itself (ptn)

2263 "Return list of start/end point of <tag options...> itself."

2264 (if (re-search-forward ptn nil t)

2265 (let ((m0 (match-beginning 0)))

2266 (skip-chars-forward "^>")

2267 (cons m0 (1+ (point) )))))

2268

2269 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2270 (and (featurep 'hilit19)

2271 (or (assq 'yahtml-mode hilit-patterns-alist)

2272 (setq hilit-patterns-alist

2273 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2274 hilit-patterns-alist))))

2275

2276 (run-hooks 'yahtml-load-hook)

2277 (provide 'yahtml)

2278

2279 ; Local variables:

2280 ; fill-prefix: ";;; "

2281 ; paragraph-start: "^$\\|\\|;;;$"

2282 ; paragraph-separate: "^$\\|\\|;;;$"

2283 ; End: