yatex: 207f0b4af9df yahtml.el

yatex

view yahtml.el @ 153:207f0b4af9df

Unescape URL strings from buffer(yahtml-unescape-string).

author	yuuji@gentei.org
date	Sat, 06 Nov 2010 19:24:34 +0900
parents	f9d3c2451d19
children	d3bcc4e2166a

line source

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

3 ;;; Last modified Sat Nov 6 19:22:54 2010 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.74.2"

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 "firefox")

18 ;;; ;Write your favorite browser. But firefox 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 "firefox")

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

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

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

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

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

39 ;;;

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

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

42 ;;;

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

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

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

46 ;;; AddType "text/html; charset=utf-8" .html (UTF-8の場合)

47 ;;;

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

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

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

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

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

53 ;;;

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

55 ;;;

56 ;;;[Commentary]

57 ;;;

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

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

60 ;;;

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

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

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

64 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

89 ;;; change the reference link with completion.

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

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

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

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

94 ;;; is "firefox")

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

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

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

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

99 ;;; in the region.

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

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

102 ;;; URLencoded string in the region.

103 ;;;

104 ;;;[キーの説明]

105 ;;;

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

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

108 ;;;

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

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

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

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

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

114 ;;; できます。

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

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

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

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

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

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

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

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

123 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

135 ;;; す。

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

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

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

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

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

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

142 ;;; きます。

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

144 ;;; す。

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

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

147 ;;; く。お推めは "firefox" です)

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

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

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

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

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

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

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

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

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

157 ;;;

158 ;;; [謝辞]

159 ;;;

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

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

162 ;;;

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

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

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

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

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

168 ;;;

169

170

171 (require 'yatexlib)

172 ;;; --- customizable variable starts here ---

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

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

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

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

177 (defvar yahtml-kanji-code 2

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

179 ;;(defvar yahtml-coding-system

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

181 ;; "Kanji coding system")

182 (and (featurep 'mule)

183 (integerp yahtml-kanji-code)

184 (setq yahtml-kanji-code

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

186

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

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

189

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

191 (defvar yahtml-path-url-alist nil

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

193 Ex.

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

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

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

197 "*Directory index file name;

198 Consult your site's WWW administrator.")

199

200 (defvar yahtml-environment-indent 1

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

202

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

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

205 "*Program name to lint HTML file")

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

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

208

209 (defvar yahtml-always-/p t

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

211 (defvar yahtml-always-/li nil

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

213 (defvar yahtml-always-/dt nil

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

215 (defvar yahtml-always-/dd nil

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

217

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

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

220

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

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

223

224 (defvar yahtml-prefer-upcases nil

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

226

227 (defvar yahtml-prefer-upcase-attributes nil

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

229

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

231

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

233 "*Server access file name for apache")

234

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

236

237 (defvar yahtml-image-inspection-bytes 50000

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

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

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

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

242 %f: filename")

243

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

245 (defvar yahtml-error-line-regexp

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

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

248

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

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

251 (defvar yahtml-escape-chars 'ask

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

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

254 at each reserved chars.")

255

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

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

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

259

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

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

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

263

264 (defvar yahtml-mode-abbrev-table nil

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

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

267

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

269 "*Boundary regexp for indentation calculation.")

270

271 (defvar yahtml-html4-strict t

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

273 Completing read for obsoleted attributes disabled.")

274

275 ;;; --- customizable variable ends here ---

276 (defvar yahtml-prefix-map nil)

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

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

279 (defvar yahtml-shell-command-option

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

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

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

283

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

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

286 (YaTeX-define-key

287 key

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

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

290 map))

291

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

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

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

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

296

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

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

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

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

301 (if YaTeX-inhibit-prefix-letter nil

302 (yahtml-define-begend-region-key

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

304

305 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

318 (let ((map yahtml-prefix-map))

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

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

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

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

323 (and YaTeX-emacs-19 window-system

324 (progn

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

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

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

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

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

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

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

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

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

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

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

336 (if YaTeX-no-begend-shortcut

337 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

374 (substitute-all-key-definition

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

376 (substitute-all-key-definition

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

378

379 (if yahtml-lint-buffer-map nil

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

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

382

383

384 (defvar yahtml-paragraph-start

385 (concat

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

387 "*Regexp of html paragraph separater")

388 (defvar yahtml-paragraph-separate

389 (concat

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

391 "*Regexp of html paragraph separater")

392 (defvar yahtml-syntax-table nil

393 "*Syntax table for yahtml-mode")

394

395 (if yahtml-syntax-table nil

396 (setq yahtml-syntax-table

397 (make-syntax-table (standard-syntax-table)))

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

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

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

401

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

403 "Regexp of constituent of html commands.")

404

405 ;;; Completion tables for `form'

406 (defvar yahtml-form-table

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

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

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

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

411

412 (defvar yahtml-env-table

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

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

415 ("OrderedList" . "ol")

416 ("UnorderedList" . "ul")

417 ("DefinitionList" . "dl")

418 ("Preformatted" . "pre")

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

420 ("address") ("button")

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

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

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

424 ))

425

426 (if yahtml-html4-strict

427 (setq yahtml-env-table

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

429

430 ;(defvar yahtml-itemizing-regexp

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

432 ; "Regexp of itemizing forms")

433

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

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

436

437 ;;; Completion tables for typeface designator

438 (and yahtml-always-/p

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

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

441 (and yahtml-always-/li

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

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

444 (and yahtml-always-/dt

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

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

447 (and yahtml-always-/dd

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

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

450

451 (defvar yahtml-typeface-table

452 (append

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

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

455 ("sup") ("sub") ("span") ("abbr"))

456 (if (not yahtml-html4-strict)

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

458 yahtml-env-table)

459 "Default completion table of typeface designator")

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

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

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

463

464 (defvar yahtml-single-cmd-table

465 '(("hr") ("br") ("option")

466 ("HorizontalRule" . "hr")

467 ("BreakLine" . "br")

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

469 ("!--#exec")

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

471 ("!--#include")

472 ;; ("Item" . "li")

473 ;; ("DefineTerm" . "dt")

474 ;; ("Description" . "dd")

475 ;; ("dd") ("dt") ("li")

476 )

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

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

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

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

481

482 (defvar yahtml-current-completion-type nil

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

484

485 (defvar yahtml-struct-name-regexp

486 (concat

487 "\\<\\("

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

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

490 "\\)\\b")

491 "Regexp of structure beginning.")

492

493 (defvar yahtml-closable-regexp

494 (concat

495 "\\<\\("

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

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

498 "\\)\\b")

499 "Regexp of any closable elemnts.")

500

501 (defvar yahtml-indent-listing-constant t

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

503 T for static indentation depth")

504

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

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

507

508

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

510 (cond

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

512 buffer-file-name)

513 (let ((dir default-directory)

514 charset af ext (ldir "")

515 line

516 (case-fold-search t)

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

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

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

520 (while (and dir

521 (not (string= dir ldir))

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

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

524 (if (file-exists-p af)

525 (save-excursion

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

527 (save-excursion

528 (goto-char (point-min))

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

530 (setq line (buffer-substring

531 (point-beginning-of-line)

532 (point-end-of-line))

533 dir nil)))

534 (kill-buffer (current-buffer))))

535 (if dir

536 (setq ldir dir

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

538 dir (file-name-directory dir))))

539 line))

540 (t nil)))

541

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

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

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

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

546 (case-fold-search t)

547 line

548 charset)

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

550 (progn

551 (string-match ptn line)

552 (setq charset

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

554 (cond

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

556 (setq charset 2))

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

558 (setq charset 3))

559 ((string-match "shift_jis" charset)

560 (setq charset 1))

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

562 (setq charset 4))

563 (t (setq charset nil)))

564 (setq dir "")))

565 (if (featurep 'mule)

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

567 charset))

568

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

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

571 x index-list)

572 ;;s/\\s *$//;

573 (if line

574 (progn

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

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

577 (while (string< "" line)

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

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

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

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

582 line "")))

583 (or (nreverse index-list)

584 (if (listp yahtml-directory-index)

585 yahtml-directory-index

586 (list yahtml-directory-index)))))))

587

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

589 (defun yahtml-mode ()

590 (interactive)

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

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

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

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

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

596 (cond

597 ((null coding) nil)

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

599 (setq buffer-file-coding-system

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

601 (save-excursion

602 (goto-char (point-min))

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

604 coding)))

605 ((featurep 'mule)

606 (set-file-coding-system coding))

607 ((boundp 'NEMACS)

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

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

610 (setq major-mode 'yahtml-mode

611 mode-name "yahtml"

612 YaTeX-current-file-name (file-name-nondirectory

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

614 local-abbrev-table yahtml-mode-abbrev-table)

615 (mapcar

616 (function (lambda (x)

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

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

619 (boundp (cdr x)))

620 (symbol-value (cdr x))

621 (cdr x)))))

622 '((YaTeX-ec . "")

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

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

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

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

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

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

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

630 (paragraph-start . yahtml-paragraph-start)

631 (paragraph-separate . yahtml-paragraph-separate)

632 (comment-start . "")

633 (comment-start-skip . comment-start)

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

635

636 (if yahtml-use-font-lock

637 (progn

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

639 (or (featurep 'xemacs)

640 (progn

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

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

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

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

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

646 (font-lock-fontify-buffer)))))

647 (set-syntax-table yahtml-syntax-table)

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

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

650 (yahtml-css-scan-styles)

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

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

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

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

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

656

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

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

659 font-lock-defaults)

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

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

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

663

664 (defun yahtml-version ()

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

666 (interactive)

667 (message

668 (concat "Yet Another HTML-mode "

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

670 " Revision "

671 yahtml-revision-number)))

672

673 (defun yahtml-quit ()

674 (interactive)

675 (and yahtml-mode-old-mode

676 (fboundp yahtml-mode-old-mode)

677 (funcall yahtml-mode-old-mode)))

678

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

680 (cond

681 ((featurep 'xemacs)

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

683 (set keymap nil)

684 (mapcar

685 (function

686 (lambda (bind)

687 (setq bind (cdr bind))

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

689 (setcar (cdr bind) 'progn))

690 (if (stringp (car (cdr bind)))

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

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

693 (symbol-value keymap))))))

694 bindlist)

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

696 (t

697 (mapcar

698 (function

699 (lambda (bind)

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

701 bindlist))))

702

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

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

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

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

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

708

709 ;;; Variables for mosaic url history

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

711 (defvar yahtml-urls-private nil)

712 (defvar yahtml-urls-local nil)

713

714 (cond

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

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

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

718 (YaTeX-define-menu

719 'yahtml-menu-map-sectioning

720 (nreverse

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

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

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

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

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

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

727 )))

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

729 (YaTeX-define-menu

730 'yahtml-menu-map-logical

731 (nreverse

732 '((em "Embolden" .

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

734 (dfn "Define a word" .

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

736 (cite "Citation" .

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

738 (code "Code" .

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

740 (kbd "Keyboard" .

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

742 (samp "Sample display" .

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

744 (strong "Strong" .

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

746 (VAR "Variable notation" .

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

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

749 (YaTeX-define-menu

750 'yahtml-menu-map-typeface

751 (nreverse

752 '((b "Bold" .

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

754 (i "Italic" .

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

756 (tt "Typewriter" .

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

758 (u "Underlined" .

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

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

761 (YaTeX-define-menu

762 'yahtml-menu-map-listing

763 (nreverse

764 '((ul "Unordered" .

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

766 (ol "Ordered" .

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

768 (dl "Definition" .

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

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

771 (YaTeX-define-menu

772 'yahtml-menu-map-item

773 (nreverse

774 '((li "Simple item" .

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

776 (dt "Define term" .

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

778 (dd "Description of term" .

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

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

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

782 (YaTeX-define-menu

783 'yahtml-menu-map

784 (nreverse

785 (list

786 (cons (list 'sect "Sectioning")

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

788 (cons (list 'list "Listing")

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

790 (cons (list 'item "Item")

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

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

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

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

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

796 (if (featurep 'xemacs)

797 (add-hook 'yahtml-mode-hook

798 '(lambda ()

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

800 (progn

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

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

803

804 ;;; ----------- Completion ----------

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

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

807 "Insert <cmd> ... </cmd>."

808 (interactive "P")

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

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

811 (cmd

812 (or env

813 (YaTeX-cplread-with-learning

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

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

816 (bolp (save-excursion

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

818 (cc (current-column)))

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

820 (setq yahtml-last-begend

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

822 yahtml-last-begend))

823 (setq cmd yahtml-last-begend)

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

825 (if region

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

827 ;; to enable continuous regioning by another environment

828 (let ((beg (region-beginning))

829 (end (region-end))

830 (addin (yahtml-addin cmd)))

831 (save-excursion

832 (goto-char end)

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

834 (goto-char beg)

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

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

837 (save-excursion

838 (insert "\n")

839 (indent-to-column cc)

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

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

842 (newline)

843 (yahtml-intelligent-newline nil))

844 (yahtml-indent-line))))

845

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

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

848 (interactive)

849 (yahtml-insert-begend t))

850

851

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

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

854 (interactive)

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

856 (or form

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

858 (setq form

859 (YaTeX-cplread-with-learning

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

861 'yahtml-form-table 'yahtml-user-form-table

862 'yahtml-tmp-form-table))))

863 (let ((p (point)) q)

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

865 (setq yahtml-last-form form)

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

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

868 ;;(indent-relative-maybe)

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

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

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

872

873 (defun yahtml-read-css (alist)

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

875 (minibuffer-completion-table alist))

876 (read-from-minibuffer

877 (substitute-command-keys

878 (if YaTeX-japan

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

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

881 nil YaTeX-minibuffer-completion-map nil)))

882

883 (defvar yahtml-newpage-command "newpage.rb"

884 "*Command name to create new HTML file referring to index.html.

885 This command should create new HTML file named argument 1 and

886 output string like `<a href=\"newfile.html\">anchor tag</a>'.

887 This program should take -o option to overwrite existing HTML file.")

888 (defun yahtml-newpage (file ov)

889 "Create newpage via newpage script"

890 (interactive

891 (list

892 (let (insert-default-directory)

893 (read-file-name "New webpage file name: " ""))

894 current-prefix-arg))

895 (if (and (file-exists-p file) (not ov))

896 (error "%s already exists. Call this with universal argument to force overwrite." file))

897 (insert (substring

898 (YaTeX-command-to-string

899 (concat yahtml-newpage-command " " (if ov "-o ") file))

900 0 -1)))

901

902 ;;; ---------- Add-in ----------

903 (defun yahtml-addin (form)

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

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

906 (concat

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

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

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

910 (not (string-match "#" form))

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

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

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

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

915 (string< "" s))

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

917 ""))))

918

919 (defvar yahtml-completing-buffer nil)

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

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

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

923 (let (list end)

924 (save-excursion

925 (set-buffer yahtml-completing-buffer)

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

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

928 (save-excursion

929 (goto-char (point-min))

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

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

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

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

934 (setq end (match-end 0))

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

936 (yahtml-on-assignment-p)

937 (progn

938 (goto-char end)

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

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

941 (setq list (cons

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

943 list))))

944 list))))

945

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

947 (if yahtml-url-completion-map nil

948 (setq yahtml-url-completion-map

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

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

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

952

953 (defun yahtml-complete-url ()

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

955 (interactive)

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

957 (lim (YaTeX-minibuffer-begin))

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

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

960 (cond

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

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

963 listfunc (list 'lambda nil

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

965 beg min))

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

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

968 (progn

969 (setq path (substring initial 0 beg))

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

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

972 (setq initial (substring initial beg))

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

974 cmpl (try-completion initial labels)

975 listfunc (list 'lambda ()

976 (list 'all-completions

977 initial (list 'quote labels)))

978 beg (+ min beg)))

979 (t

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

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

982 initial))

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

984 file (file-name-nondirectory path)

985 initial file

986 cmpl (file-name-completion file dir)

987 listfunc (list 'lambda nil

988 (list 'file-name-all-completions

989 file dir))

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

991 (cond

992 ((stringp cmpl)

993 (if (string= initial cmpl)

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

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

996 (princ

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

998 (delete-region (point) beg)

999 (insert cmpl)))

1000 ((null cmpl)

1001 (ding))

1002 ((eq t cmpl)

1003 (save-excursion

1004 (unwind-protect

1005 (progn

1006 (goto-char p)

1007 (insert " [Sole completion]"))

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

1009

1010 ;

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

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

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

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

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

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

1017 ;

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

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

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

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

1022 (defvar yahtml-unsafe-chars-regexp

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

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

1025 ;

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

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

1028 ;

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

1030 ; "$" | ","

1031 (defvar yahtml-unreserved-chars-regexp

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

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

1034 Not used yet.")

1035

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

1037 "Translate reserved chars to URL encoded string."

1038 (let ((p 0) (target "")

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

1040 (cond

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

1042 (t

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

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

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

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

1047 (setq target (concat target

1048 (substring str 0 p)

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

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

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

1052 (concat target str)))))

1053

1054 (defun yahtml-unescape-string (str)

1055 "Untranslate reserved URL-encoded string."

1056 (let ((p 0) c (target "") (md (match-data)) (case-fold-search nil))

1057 (unwind-protect

1058 (progn

1059 (while (string-match "%\$[0-9a-f][0-9a-f]\$" str p)

1060 (setq target (concat target

1061 (substring str p (1- (match-beginning 1))))

1062 p (match-end 0)

1063 c (YaTeX-hex (substring

1064 str (match-beginning 1) (match-end 1)))

1065 target (concat target (format "%c" c))))

1066 (concat target (substring str p)))

1067 (store-match-data md))))

1068

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

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

1071 (interactive "r")

1072 (save-excursion

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

1074 (goto-char beg)

1075 (while (and (< (point) e)

1076 (re-search-forward

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

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

1079 (sit-for 0)

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

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

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

1083 ; (unwind-protect

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

1085 ; (save-excursion

1086 ; (backward-char 1)

1087 ; (delete-backward-char 4))

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

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

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

1091 (progn

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

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

1094 (set-marker e nil))))

1095 ;; ab%defgls/.|

1096

1097 (defun yahtml:a ()

1098 "Add-in function for <a>"

1099 (let ((href ""))

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

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

1102 href (yahtml-escape-chars-string

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

1104 (prog1

1105 (concat (yahtml-make-optional-argument

1106 "href" href)

1107 (yahtml-make-optional-argument

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

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

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

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

1112 (YaTeX-update-table

1113 (list href)

1114 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1115

1116 (defvar yahtml-parameters-completion-alist

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

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

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

1120 ("src" . file) ("file" . file)

1121 ("background" . file)

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

1123 ("method" ("POST") ("GET"))

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

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

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

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

1128 ("http-equiv" ("Refresh"))))

1129

1130 (defvar yahtml-link-types-alist

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

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

1133 ("subsection") ("appendix") ("help") ("bookmark")))

1134

1135 (defvar yahtml-content-types-alist

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

1137 ("text/sgml") ("text/xml")

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

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

1140 ("application/java")

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

1142 "Alist of content-types")

1143

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

1145 (let* ((alist

1146 (cdr-safe (assoc (downcase par)

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

1148 (prompt (concat par ": "))

1149 v)

1150 (cond

1151 ((eq alist 'file)

1152 (let ((insert-default-directory))

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

1154 ((eq alist 'command)

1155 (if (fboundp 'read-shell-command)

1156 (read-shell-command prompt)

1157 (read-string prompt)))

1158 ((and alist (symbolp alist))

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

1160 (alist

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

1162 (t

1163 (read-string prompt default)))))

1164

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

1166 "Make optional argument string."

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

1168 ""

1169 (concat " "

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

1171 "=\"" arg "\"")))

1172

1173 (defun yahtml:html ()

1174 "Add-in for <html>"

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

1176 (yahtml-make-optional-argument

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

1178

1179 (defun yahtml:head ()

1180 "Add-in for <head>"

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

1182 "")

1183

1184 (defun yahtml:body ()

1185 "Add-in function for <body>"

1186 (cond

1187 (yahtml-html4-strict nil)

1188 (t

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

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

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

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

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

1194 (concat

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

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

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

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

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

1200

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

1202 "Make CSS property definitions in style attribute."

1203 (mapconcat

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

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

1206 (delq nil proplist)

1207 " "))

1208

1209 (defun yahtml:img ()

1210 "Add-in function for <img>"

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

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

1213 alt

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

1215 (l yahtml-prefer-upcase-attributes)

1216 info width height bytes comments)

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

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

1219 (car info)

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

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

1222 bytes (car (cdr (cdr info)))

1223 comments (nth 4 info)))

1224 (if info

1225 (setq alt

1226 (YaTeX-replace-formats

1227 yahtml:img-default-alt-format

1228 (list (cons "x" width)

1229 (cons "y" height)

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

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

1232 (cons "c" (car comments))))))

1233

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

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

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

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

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

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

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

1241 (if yahtml-html4-strict

1242 (yahtml-make-optional-argument

1243 "style"

1244 (if (or brd alg)

1245 (yahtml-make-style-parameter

1246 (list

1247 (if (string< "" alg)

1248 (cons "align" alg))

1249 (if (string< "" brd)

1250 (cons "border"

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

1252 (concat

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

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

1255

1256 (defun yahtml-file-truename (file)

1257 (cond

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

1259 (t (let ((new file))

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

1261 (not (equal new file)))

1262 (setq file new))

1263 file))))

1264

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

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

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

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

1269 (let ((mlt 1)

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

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

1272 (value 0))

1273 (while (> length 0)

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

1275 pos (+ pos direc)

1276 mlt (* mlt 256)

1277 length (1- length)))

1278 value))

1279

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

1281 "Return the information on the image file FILE.

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

1283 (save-excursion

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

1285 width height bytes depth comment

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

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

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

1289 (seekpoint 1)

1290 c1 c2 c3 c4 beg end

1291 (case-fold-search nil))

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

1293 (set-buffer tmpbuf)

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

1295 (erase-buffer)

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

1297 (unwind-protect

1298 (progn

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

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

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

1302 (YaTeX-insert-file-contents

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

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

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

1306 c2 (char-after 2)

1307 c3 (char-after 3)

1308 c4 (char-after 4))

1309 (cond

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

1311 ;;JPEG images need JPEG markers inspection

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

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

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

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

1316 (catch 'exit

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

1318 (cond

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

1320 ;maybe corrupted, exit from loop

1321 (throw 'exit t))

1322 ((memq

1323 (char-after (1+ seekpoint))

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

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

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

1327 ;;found!

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

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

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

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

1332 ;; JPEG comment area

1333 (setq beg (+ seekpoint 2 2)

1334 end (+ seekpoint

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

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

1337 (t ;other markers

1338 nil)) ;just skip it

1339 (setq seekpoint (+ seekpoint 2)

1340 seekpoint (+ seekpoint

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

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

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

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

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

1346 height (yahtml-hex-value 20 4)

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

1348 ((looking-at "GIF8")

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

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

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

1352 ((looking-at "BM")

1353 ;;# OS/2, Windoze BMP files

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

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

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

1357 (cond

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

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

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

1361 (t

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

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

1364 (message "")

1365 (kill-buffer tmpbuf))

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

1367

1368 (defun yahtml:form ()

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

1370 (concat

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

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

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

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

1375

1376 (defun yahtml:select ()

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

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

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

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

1381

1382 (defun yahtml:ol ()

1383 "Add-in function for <ol>"

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

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

1386 (type (completing-read

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

1388 (concat

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

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

1391 (defun yahtml:ul ()

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

1393 (defun yahtml:dl ()

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

1395 (defun yahtml:dt ()

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

1397

1398 (defun yahtml:p ()

1399 (if yahtml-html4-strict nil

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

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

1402

1403 (defvar yahtml-input-types

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

1405 ("reset") ("image") ("hidden") ("file")))

1406

1407 (defun yahtml:input ()

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

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

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

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

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

1413 yahtml-input-types nil t)

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

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

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

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

1418 (concat

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

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

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

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

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

1424

1425 (defun yahtml:textarea ()

1426 "Add-in function for `textarea'"

1427 (interactive)

1428 (let (name rows cols)

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

1430 cols (read-string "Columns: ")

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

1432 (concat

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

1434 "\"" name "\"")

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

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

1437

1438 (defun yahtml:table ()

1439 "Add-in function for `table'"

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

1441 (a (yahtml-read-parameter

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

1443 (if yahtml-html4-strict

1444 (yahtml-make-optional-argument

1445 "style"

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

1447 (yahtml-make-style-parameter

1448 (append

1449 (if (string< "" b)

1450 (list

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

1452 (cons "border-collapse" "collapse")))

1453 (if (string< "" a)

1454 (cond

1455 ((string-match "right" a)

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

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

1458 ((string-match "center" a)

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

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

1461 (concat

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

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

1464

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

1466 (defun yahtml:caption ()

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

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

1469 (if yahtml-html4-strict

1470 (yahtml-make-optional-argument

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

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

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

1474

1475 (defun yahtml:font ()

1476 "Add-in function for `font'"

1477 (concat

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

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

1480

1481 (defun yahtml:style ()

1482 "Add-in function for `style'"

1483 (yahtml-make-optional-argument

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

1485

1486 (defun yahtml:script ()

1487 "Add-in function for `script'"

1488 (concat

1489 (yahtml-make-optional-argument

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

1491 (yahtml-make-optional-argument

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

1493

1494 (defun yahtml:tr ()

1495 "Add-in function for `tr'"

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

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

1498 "")

1499

1500 (defun yahtml:link ()

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

1502 (let (rel rev type href)

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

1504 (cond

1505 ((equal rel "")

1506 (concat (yahtml-make-optional-argument

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

1508 (yahtml-make-optional-argument

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

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

1511 )))

1512 ((string-match "stylesheet" rel)

1513 (concat

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

1515 (yahtml-make-optional-argument

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

1517 (progn

1518 (setq href

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

1520 (if (string< "" href)

1521 (progn

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

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

1524 (setq yahtml-css-class-alist

1525 (yahtml-css-collect-classes-file

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

1527 (message "")

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

1529 (t

1530 (concat

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

1532 (yahtml-make-optional-argument

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

1534 (yahtml-make-optional-argument

1535 "href"

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

1537

1538 (defvar yahtml:meta-names

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

1540

1541 (defun yahtml:meta ()

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

1543 "name"

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

1545 http-equiv content)

1546 (if (string= "" name)

1547 (if (string-match

1548 "Content-type"

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

1550 "http-equiv"

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

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

1553 "See docs/qanda")

1554 (concat http-equiv

1555 (yahtml-make-optional-argument

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

1557 (concat

1558 name

1559 (yahtml-make-optional-argument

1560 "content"

1561 (cond

1562 ((string-match "date" name)

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

1564 ((string-match "author" name)

1565 (read-string "Author: "

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

1567 (user-full-name)

1568 (user-login-name))))

1569 ((string-match "GENERATOR" name)

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

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

1572 (message "Thank you!"))

1573 content)

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

1575

1576 (defun yahtml:br ()

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

1578

1579 (defun yahtml:object ()

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

1581 data classid)

1582 (cond

1583 ((string-match "java" codetype)

1584 (let ((completion-ignored-extensions

1585 ;;any extensions except ".class"

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

1587 (setq classid (concat "java:"

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

1589 (concat

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

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

1592 (yahtml-make-optional-argument

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

1594 (yahtml-make-optional-argument

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

1596 (yahtml-make-optional-argument

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

1598 (t

1599 ""))))

1600

1601 (defun yahtml:abbr ()

1602 "Add-in function for abbr."

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

1604

1605 (defun yahtml:button ()

1606 (concat

1607 (yahtml-make-optional-argument

1608 "name" (yahtml-read-parameter "name"))

1609 (yahtml-make-optional-argument

1610 "type" (yahtml-read-parameter

1611 "type" "button" '(("submit")("reset")("button"))))

1612 (yahtml-make-optional-argument

1613 "value" (yahtml-read-parameter "value"))))

1614

1615 ;;; ---------- Simple tag ----------

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

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

1618 (interactive "P")

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

1620 (or tag

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

1622 (setq tag

1623 (YaTeX-cplread-with-learning

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

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

1626 'yahtml-typeface-table 'yahtml-user-typeface-table

1627 'yahtml-tmp-typeface-table))))

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

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

1630 (setq yahtml-last-typeface-cmd tag

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

1632 (if region-mode

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

1634 (save-excursion

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

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

1637 (exchange-point-and-mark)

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

1639 (message "No mark set now"))

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

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

1642

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

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

1645 (interactive)

1646 (yahtml-insert-tag t tag))

1647

1648 (defvar yahtml-need-single-closer nil) ;for test

1649 (defun yahtml-insert-single (cmd)

1650 "Insert <CMD>."

1651 (interactive

1652 (list

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

1654 (YaTeX-cplread-with-learning

1655 (format "Command%s: "

1656 (if yahtml-last-single-cmd

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

1658 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1661 (setq yahtml-last-single-cmd

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

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

1664 yahtml-last-single-cmd))

1665 (insert (format "<%s%s%s>"

1666 cmd

1667 (yahtml-addin cmd)

1668 (if (and yahtml-need-single-closer

1669 (assoc cmd '(("br")("hr"))))

1670 " /" "")))

1671 (if (assoc cmd yahtml-env-table)

1672 (save-excursion (insert (format "</%s>" cmd)))))

1673

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

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

1676 (interactive "P")

1677 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")

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

1679

1680 (defun yahtml-insert-amps (arg)

1681 "Insert char-entity references via ampersand"

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

1683 (interactive "P")

1684 (let*((mess "") c

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

1686 yahtml-entity-reference-chars-alist))

1687 (l list))

1688 (while l

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

1690 l (cdr l)))

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

1692 (setq c (read-char))

1693 (cond

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

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

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

1697 (insert "&;")

1698 (forward-char -1))

1699 ((equal c ? )

1700 (insert ?&))

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

1702

1703 (defun yahtml:!--\#include ()

1704 (let ((file (yahtml-read-parameter "file" "")))

1705 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1706

1707 (defun yahtml:!--\#exec ()

1708 (format "cmd=\"%s\"--"

1709 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))

1710

1711 ;;; ---------- Jump ----------

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

1713 "Check if point is on href clause."

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

1715 (save-excursion

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

1717 (save-excursion

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

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

1720 (setq e (point)))

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

1722 (re-search-backward "<\$a\\|link\$\\>" nil t)

1723 (search-forward "href" e t)

1724 (search-forward "=" e t)

1725 (progn

1726 (skip-chars-forward " \t\n")

1727 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

1728 (< p (match-end 0))

1729 (yahtml-unescape-string (YaTeX-match-string 1))))))

1730

1731 (defun yahtml-netscape-sentinel (proc mes)

1732 (cond

1733 ((null (buffer-name (process-buffer proc)))

1734 (set-process-buffer proc nil))

1735 ((eq (process-status proc) 'exit)

1736 (let ((cb (current-buffer)))

1737 (set-buffer (process-buffer proc))

1738 (goto-char (point-min))

1739 (if (search-forward "not running" nil t)

1740 (progn

1741 (message "Starting netscape...")

1742 (start-process

1743 "browser" (process-buffer proc)

1744 shell-file-name yahtml-shell-command-option

1745 (format "%s \"%s\"" yahtml-www-browser

1746 (get 'yahtml-netscape-sentinel 'url)))

1747 (message "Starting netscape...Done")))

1748 (set-buffer cb)))))

1749

1750 (defvar yahtml-browser-process nil)

1751

1752 (defun yahtml-browse-html (href)

1753 "Call WWW Browser to see HREF."

1754 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1755 (cond

1756 ((string-match "^start\\>" yahtml-www-browser)

1757 (if (get-buffer pb)

1758 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1759 (put 'yahtml-netscape-sentinel 'url href)

1760 (set-process-sentinel

1761 (setq yahtml-browser-process

1762 (start-process

1763 "browser" pb shell-file-name yahtml-shell-command-option

1764 (format "%s \"%s\"" yahtml-www-browser href)))

1765 'yahtml-netscape-sentinel))

1766 ((and (string-match

1767 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

1768 (not (eq system-type 'windows-nt)))

1769 (if (get-buffer pb)

1770 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1771 (put 'yahtml-netscape-sentinel 'url href)

1772 (set-process-sentinel

1773 (setq yahtml-browser-process

1774 (start-process

1775 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1776 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1777 'yahtml-netscape-sentinel))

1778 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1779 (w3-fetch href))

1780 ((stringp yahtml-www-browser)

1781 (if (and yahtml-browser-process

1782 (eq (process-status yahtml-browser-process) 'run))

1783 (message "%s is already running" yahtml-www-browser)

1784 (setq yahtml-browser-process

1785 (start-process

1786 "browser" "* WWW Browser *"

1787 shell-file-name yahtml-shell-command-option

1788 (format "%s \"%s\"" yahtml-www-browser href)))))

1789 (t

1790 (message "Sorry, jump across http is not supported.")))))

1791

1792 (defun yahtml-goto-corresponding-href (&optional other)

1793 "Go to corresponding name."

1794 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1795 (if href

1796 (cond

1797 ((string-match "^\$ht\\|f\$tps?:" href)

1798 (yahtml-browse-html href))

1799 (t (setq file (substring href 0 (string-match "#" href)))

1800 (if (string-match "#" href)

1801 (setq name (substring href (1+ (string-match "#" href)))))

1802 (if (string< "" file)

1803 (progn

1804 (if (string-match "/$" file)

1805 (or (catch 'dirindex

1806 (mapcar

1807 (function

1808 (lambda (f)

1809 (if (file-exists-p (concat file f))

1810 (throw 'dirindex

1811 (setq file (concat file f))))))

1812 (yahtml-get-directory-index))

1813 nil)

1814 (setq file (concat file yahtml-directory-index))))

1815 (if (string-match "^/" file)

1816 (setq file (yahtml-url-to-path file)))

1817 (if other (YaTeX-switch-to-buffer-other-window file)

1818 (YaTeX-switch-to-buffer file))

1819 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1820 (if name

1821 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1822 t)))))

1823

1824 (defun yahtml-jump-to-name (name)

1825 "Jump to html's named tag."

1826 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1827 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1828 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1829 (message "Named tag `%s' not found" (substring href 1))))

1830

1831 (defun yahtml-on-begend-p (&optional p)

1832 "Check if point is on begend clause."

1833 (let ((p (or p (point))) cmd (case-fold-search t))

1834 (save-excursion

1835 (goto-char p)

1836 (if (equal (char-after (point)) ?<) (forward-char 1))

1837 (if (and (re-search-backward "<" nil t)

1838 (looking-at

1839 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1840 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1841 (condition-case nil

1842 (forward-list 1)

1843 (error nil))

1844 (< p (point)))

1845 (YaTeX-match-string 1)))))

1846

1847 (defun yahtml-goto-corresponding-begend (&optional noerr)

1848 "Go to corresponding opening/closing tag.

1849 Optional argument NOERR causes no error for unballanced tag."

1850 (let ((cmd (yahtml-on-begend-p)) m0

1851 (p (point)) (case-fold-search t) func str (nest 0))

1852 (cond

1853 (cmd

1854 (setq m0 (match-beginning 0))

1855 (if (= (aref cmd 0) ?/) ;on </cmd> line

1856 (setq cmd (substring cmd 1)

1857 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1858 func 're-search-backward)

1859 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1860 func 're-search-forward))

1861 (while (and (>= nest 0) (funcall func str nil t))

1862 (if (equal m0 (match-beginning 0))

1863 nil

1864 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1865 (if (< nest 0)

1866 (goto-char (match-beginning 0))

1867 (funcall

1868 (if noerr 'message 'error)

1869 "Corresponding tag of `%s' not found." cmd)

1870 (goto-char p)

1871 nil))

1872 (t nil))))

1873

1874 (defun yahtml-current-tag ()

1875 "Return the current tag name including #exec and #include."

1876 (save-excursion

1877 (let ((p (point)) b tag)

1878 (or (bobp)

1879 (looking-at "<")

1880 (progn (skip-chars-backward "^<") (forward-char -1)))

1881 (setq b (point))

1882 (skip-chars-forward "<")

1883 (setq tag (YaTeX-buffer-substring

1884 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1885 (goto-char b)

1886 (forward-list 1)

1887 (and (< p (point)) tag))))

1888

1889 (defun yahtml-get-attrvalue (attr)

1890 "Extract current tag's attribute value from buffer."

1891 (let (e (case-fold-search t))

1892 (save-excursion

1893 (or (looking-at "<")

1894 (progn (skip-chars-backward "^<") (backward-char 1)))

1895 (setq e (save-excursion (forward-list 1) (point)))

1896 (if (and

1897 (re-search-forward (concat "\\b" attr "\\b") e t)

1898 (progn (skip-chars-forward " \t\n=")

1899 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1900 (YaTeX-match-string 1)))))

1901

1902 (defun yahtml-goto-corresponding-img ()

1903 "View image on point"

1904 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1905 (if (and tag

1906 (string-match "img" tag)

1907 (setq image

1908 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1909 (progn

1910 (message "Invoking %s %s..." yahtml-image-viewer image)

1911 (start-process

1912 "Viewer" " * Image Viewer *"

1913 shell-file-name yahtml-shell-command-option ;"-c"

1914 (concat yahtml-image-viewer " " image))

1915 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1916

1917 (defun yahtml-goto-corresponding-source (&optional other)

1918 "Goto applet's or script's source."

1919 (let ((env (yahtml-current-tag)) s (p (point)))

1920 (cond

1921 ((string-match "applet" env)

1922 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1923 (progn

1924 (setq s (YaTeX-match-string 1)

1925 s (concat

1926 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1927 ".java"))

1928 (if other (YaTeX-switch-to-buffer-other-window s)

1929 (YaTeX-switch-to-buffer s))

1930 s) ;return source file name

1931 (message "No applet source specified")

1932 (sit-for 1)

1933 nil))

1934 ((string-match "script" env)

1935 (if (setq s (yahtml-get-attrvalue "src"))

1936 (progn

1937 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1938 'YaTeX-switch-to-buffer)

1939 (yahtml-url-to-path s))

1940 s)))

1941 ((string-match "!--#include" env)

1942 (cond

1943 ((setq s (yahtml-get-attrvalue "file")) ;

1944 (if other (YaTeX-switch-to-buffer-other-window s)

1945 (YaTeX-switch-to-buffer s))

1946 s)

1947 ((setq s (yahtml-get-attrvalue "virtual"));

1948 (setq s (yahtml-url-to-path s))

1949 (if other (YaTeX-switch-to-buffer-other-window s)

1950 (YaTeX-switch-to-buffer s))

1951 s)))

1952 ((and (string-match "!--#exec" env)

1953 (setq s (yahtml-get-attrvalue "cmd")))

1954 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1955 (let ((b " *yahtmltmp*")) ;peek a little

1956 (unwind-protect

1957 (progn

1958 (set-buffer (get-buffer-create b))

1959 (YaTeX-insert-file-contents s nil 0 100)

1960 (if (looking-at "#!")

1961 (if other (YaTeX-switch-to-buffer-other-window s)

1962 (YaTeX-switch-to-buffer s))))

1963 (kill-buffer (get-buffer b)))

1964 (get-file-buffer s))))))

1965

1966 (defun yahtml-goto-corresponding-* (&optional other)

1967 "Go to corresponding object."

1968 (interactive "P")

1969 (cond

1970 ((yahtml-goto-corresponding-href other))

1971 ((yahtml-goto-corresponding-img))

1972 ((yahtml-goto-corresponding-source other))

1973 ((yahtml-goto-corresponding-begend))

1974 (t (message "I don't know where to go."))))

1975

1976 (defun yahtml-goto-corresponding-*-other-window ()

1977 "Go to corresponding object."

1978 (interactive)

1979 (yahtml-goto-corresponding-* t))

1980

1981 (defun yahtml-visit-main ()

1982 "Go to parent file from where you visit current file."

1983 (interactive)

1984 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1985

1986 ;;; ---------- killing ----------

1987 (defun yahtml-kill-begend (&optional whole)

1988 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1989 (if tag

1990 (save-excursion

1991 (or (looking-at "<")

1992 (progn (skip-chars-backward "^<") (forward-char -1)))

1993 (setq p (point))

1994 (yahtml-goto-corresponding-begend)

1995 (or (looking-at "<")

1996 (progn (skip-chars-backward "^<") (forward-char -1)))

1997 (if (< (point) p) ;if on the opening tag

1998 (progn (setq q p p (point))

1999 (goto-char q))

2000 (setq q (point))) ;now q has end-line's (point)

2001 (if (not whole)

2002 (kill-region

2003 (progn (skip-chars-backward " \t")

2004 (if (setq bbolp (bolp)) (point) q))

2005 (progn (forward-list 1)

2006 (setq r (point))

2007 (skip-chars-forward " \t")

2008 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2009 (goto-char p)

2010 (skip-chars-backward " \t")

2011 (if (not whole)

2012 (progn

2013 (kill-append

2014 (buffer-substring

2015 (setq p (if (setq bbolp (bolp)) (point) p))

2016 (setq q (progn

2017 (forward-list 1)

2018 (setq r (point))

2019 (skip-chars-forward " \t")

2020 (if (and bbolp (eolp) (not (eobp)))

2021 (1+ (point))

2022 r))))

2023 t)

2024 (delete-region p q))

2025 (kill-region

2026 (if (bolp) (point) p)

2027 (progn (goto-char q)

2028 (forward-list 1)

2029 (setq r (point))

2030 (skip-chars-forward " \t")

2031 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2032 tag))))

2033

2034 (defun yahtml-kill-* (whole)

2035 "Kill current position's HTML tag (set)."

2036 (interactive "P")

2037 (cond

2038 ((yahtml-kill-begend whole))))

2039

2040

2041 ;;; ---------- changing ----------

2042 (defun yahtml-on-assignment-p ()

2043 "Return if current point is on parameter assignment.

2044 If so, return parameter name, otherwise nil.

2045 This function should be able to treat white spaces in value, but not yet."

2046 (let ((p (point)))

2047 (save-excursion

2048 (put 'yahtml-on-assignment-p 'region nil)

2049 (skip-chars-backward "^ \t\n")

2050 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2051 (< p (match-end 0))

2052 (>= p (1- (match-beginning 2)))

2053 (put 'yahtml-on-assignment-p 'region

2054 (cons (match-beginning 2) (match-end 2)))

2055 (YaTeX-match-string 1)))))

2056

2057 (defun yahtml-change-begend ()

2058 (let ((tag (yahtml-on-begend-p))

2059 (completion-ignore-case t)

2060 (case-fold-search t)

2061 (p (point)) (q (make-marker))

2062 (default (append yahtml-env-table yahtml-typeface-table))

2063 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2064 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2065 href b1 e1 attr new css)

2066 (cond

2067 (tag

2068 (cond

2069 ((and (string-match "^a$" tag)

2070 (save-excursion

2071 (and

2072 (re-search-backward "<a\\b" nil t)

2073 (progn

2074 (goto-char (match-end 0))

2075 (skip-chars-forward " \t\n")

2076 (setq b1 (point))

2077 (search-forward ">" nil t))

2078 (setq e1 (match-beginning 0))

2079 (goto-char b1)

2080 (re-search-forward "href\\s *=" e1 t)

2081 (>= p (point))

2082 (progn

2083 (goto-char (match-end 0))

2084 (skip-chars-forward " \t\n")

2085 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2086 (< p (match-end 0)))))

2087 (setq b1 (match-beginning 1) e1 (match-end 1)

2088 yahtml-completing-buffer (current-buffer)

2089 ;; yahtml-urls-local is buffer-local, so we must put

2090 ;; that into yahtml-urls here

2091 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2092 href (read-from-minibuffer

2093 "Change href to: " "" yahtml-url-completion-map))

2094 (if (string< "" href)

2095 (progn

2096 ;;(setq href ;??

2097 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2098 (delete-region b1 e1)

2099 (goto-char b1)

2100 (insert href))))

2101 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2102 (if (and (equal attr "class") ;treat "class" attribute specially

2103 (setq css (yahtml-css-get-element-completion-alist tag)))

2104

2105 (setq new (yahtml-read-css css))

2106 ;;other than "class", read parameter normally

2107 (setq new (yahtml-read-parameter attr)))

2108 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2109 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2110 (insert new))

2111 (t

2112 (save-excursion

2113 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2114 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2115 (skip-chars-forward "^A-Za-z")

2116 (set-marker q (point))

2117 (setq p (point))

2118 (yahtml-goto-corresponding-begend)

2119 (or (= (char-after (point)) ?<)

2120 (skip-chars-backward "^<"))

2121 (skip-chars-forward "^A-Za-z")

2122 (if (= (char-after (1- (point))) ?/)

2123 (progn

2124 (set-marker q (point))

2125 (goto-char p)))

2126 (setq tag (let ((completion-ignore-case t))

2127 (YaTeX-cplread-with-learning

2128 (format "Change `%s' to(default %s): "

2129 tag yahtml-last-begend)

2130 'default 'user 'tmp)))

2131 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2132 (if (string= "" tag) (setq tag yahtml-last-begend))

2133 (setq yahtml-last-begend

2134 (or (cdr (assoc tag yahtml-env-table)) tag)

2135 tag yahtml-last-begend)

2136 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2137 (insert (format "%s%s" tag (yahtml-addin tag)))

2138 (goto-char q)

2139 (set-marker q nil)

2140 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2141 (insert tag))))

2142 t))))

2143

2144 (defun yahtml-change-command ()

2145 (let ((p (point)) (case-fold-search t) cmd par new

2146 (beg (make-marker)) (end (make-marker)))

2147 (skip-chars-backward "^<")

2148 (if (and

2149 (looking-at yahtml-command-regexp)

2150 (progn

2151 (set-marker beg (match-beginning 0))

2152 (set-marker end (match-end 0))

2153 t) ;for further work

2154 (progn

2155 (forward-char -1)

2156 (condition-case nil

2157 (forward-list 1)

2158 (error nil))

2159 (< p (point))))

2160 (progn

2161 (goto-char p)

2162 (if (setq par (yahtml-on-assignment-p))

2163 (progn

2164 (setq new (yahtml-read-parameter par))

2165 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2166 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2167 (setq new

2168 (YaTeX-cplread-with-learning

2169 "Change form to: "

2170 'yahtml-form-table 'yahtml-user-form-table

2171 'yahtml-tmp-form-table)))

2172 (delete-region beg end)

2173 (goto-char beg)

2174 (set-marker beg nil)

2175 (set-marker end nil)

2176 (insert new)

2177 t)

2178 (goto-char p)

2179 nil)))

2180

2181 (defun yahtml-change-* ()

2182 "Change current position's HTML tag (set)."

2183 (interactive)

2184 (cond

2185 ((yahtml-change-begend))

2186 ((yahtml-change-command))))

2187

2188 ;;; ---------- commenting ----------

2189

2190 (defun yahtml-comment-region (&optional uncom)

2191 "Comment out region or environment."

2192 (interactive)

2193 (let ((e (make-marker)) be beg p)

2194 (cond

2195 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2196 (setq be (yahtml-on-begend-p))

2197 (save-excursion

2198 (setq p (point))

2199 (if (string-match "^/" be)

2200 (setq beg (progn (forward-line 1) (point)))

2201 (setq beg (progn (beginning-of-line) (point))))

2202 (goto-char p)

2203 (yahtml-goto-corresponding-begend)

2204 (if (string-match "^/" be)

2205 (beginning-of-line)

2206 (forward-line 1))

2207 (set-marker e (point))

2208 ;(comment-region beg (point) (if uncom (list 4)))))

2209 ))

2210 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2211 (setq beg (region-beginning))

2212 (set-marker e (region-end))))

2213 (if yahtml-translate-hyphens-when-comment-region

2214 (let ((yahtml-entity-reference-chars-alist-default nil)

2215 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2216 yahtml-entity-reference-chars-regexp

2217 yahtml-entity-reference-chars-reverse-regexp)

2218 (yahtml-entity-reference-chars-setup)

2219 (funcall

2220 (if uncom 'yahtml-translate-reverse-region

2221 'yahtml-translate-region)

2222 beg e)))

2223 (comment-region beg e (if uncom (list 4)))

2224 (set-marker e nil)))

2225

2226 (defun yahtml-uncomment-region ()

2227 (interactive)

2228 (yahtml-comment-region t))

2229

2230 ;;; ---------- translate to entity references ----------

2231 (defvar yahtml-entity-reference-chars-alist-default

2232 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2233 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2234 "Default translation table from character to entity reference")

2235 (defvar yahtml-entity-reference-chars-alist nil

2236 "*Translation table from character to entity reference")

2237 (defvar yahtml-entity-reference-chars-regexp nil)

2238 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2239

2240 (defun yahtml-entity-reference-chars-setup ()

2241 (let ((list (append yahtml-entity-reference-chars-alist-default

2242 yahtml-entity-reference-chars-alist)))

2243 (setq yahtml-entity-reference-chars-regexp "["

2244 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2245 (while list

2246 (setq yahtml-entity-reference-chars-regexp

2247 (concat yahtml-entity-reference-chars-regexp

2248 (char-to-string (car (car list))))

2249 yahtml-entity-reference-chars-reverse-regexp

2250 (concat yahtml-entity-reference-chars-reverse-regexp

2251 (cdr (car list))

2252 (if (cdr list) "\\|")))

2253 (setq list (cdr list)))

2254 (setq yahtml-entity-reference-chars-regexp

2255 (concat yahtml-entity-reference-chars-regexp "]")

2256 yahtml-entity-reference-chars-reverse-regexp

2257 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2258

2259 (yahtml-entity-reference-chars-setup)

2260

2261 (defun yahtml-translate-region (beg end)

2262 "Translate inhibited literals."

2263 (interactive "r")

2264 (save-excursion

2265 (save-restriction

2266 (narrow-to-region beg end)

2267 (let ((ct (append yahtml-entity-reference-chars-alist

2268 yahtml-entity-reference-chars-alist-default)))

2269 (goto-char beg)

2270 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2271 ;(setq c (preceding-char))

2272 (replace-match

2273 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2274

2275 (defun yahtml-translate-reverse-region (beg end)

2276 "Translate entity references to literals."

2277 (interactive "r")

2278 (save-excursion

2279 (save-restriction

2280 (narrow-to-region beg end)

2281 (let ((ct (append yahtml-entity-reference-chars-alist

2282 yahtml-entity-reference-chars-alist-default))

2283 ec)

2284 (goto-char beg)

2285 (while (re-search-forward

2286 yahtml-entity-reference-chars-reverse-regexp nil t)

2287 ;(setq c (preceding-char))

2288 (setq ec (YaTeX-match-string 1))

2289 (delete-region (match-end 0) (match-beginning 0))

2290 (insert (car (YaTeX-rassoc ec ct))))))))

2291

2292 (defun yahtml-inner-environment-but (exclude &optional quick)

2293 "Return the inner environment but matches with EXCLUDE tag."

2294 (let (e (case-fold-search t))

2295 (save-excursion

2296 (while (and (setq e (YaTeX-inner-environment quick))

2297 (string-match exclude e))

2298 (goto-char (get 'YaTeX-inner-environment 'point))))

2299 e))

2300

2301 (defun yahtml-untranslate-string (str)

2302 "Untranslate entity reference."

2303 (let ((md (match-data)) (left "") (right str) b0 ch

2304 (ct (append yahtml-entity-reference-chars-alist

2305 yahtml-entity-reference-chars-alist-default))

2306 (revrex yahtml-entity-reference-chars-reverse-regexp))

2307 (unwind-protect

2308 (progn

2309 (while (string< "" right)

2310 (cond

2311 ((string-match revrex right)

2312 (setq ch (YaTeX-rassoc

2313 (substring right (match-beginning 1) (match-end 1)))

2314 b0 (substring right 0 (match-beginning 0))

2315 right (substring right (match-end 0))

2316 left (concat left

2317 (substring right 0 (match-beginning 0))

2318 (char-to-string ch))))

2319 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2320 (setq ch (substring right (match-beginning 2) (match-end 2))

2321 b0 (substring right 0 (match-beginning 0))

2322 right (substring right (match-end 0))

2323 left (concat left

2324 b0

2325 (char-to-string

2326 (if (match-beginning 1)

2327 (YaTeX-hex ch)

2328 (string-to-number ch))))))

2329 (t (setq left (concat left right)

2330 right ""))))

2331 left)

2332 (store-match-data md))))

2333

2334 ;;; ---------- filling ----------

2335 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2336 (defun yahtml-move-to-column (col &optional force)

2337 (beginning-of-line)

2338 (let ((ccol 0))

2339 (while (and (> col ccol) (not (eolp)))

2340 (if (eq (following-char) ?\<)

2341 (progn

2342 (while (and (not (eq (following-char) ?\>))

2343 (not (eolp)))

2344 (forward-char))

2345 (or (eolp) (forward-char)))

2346 (or (eolp) (forward-char))

2347 (if (eq (preceding-char) ?\t)

2348 (let ((wd (- 8 (% (+ ccol 8) 8))))

2349 (if (and force (< col (+ ccol wd)))

2350 (progn

2351 (backward-char 1)

2352 (insert-char ?\ (- col ccol))

2353 (setq ccol col))

2354 (setq ccol (+ ccol wd))))

2355 (setq ccol (1+ ccol)))

2356 (if (and YaTeX-japan

2357 (or

2358 (and (fboundp 'char-category)

2359 (string-match "[chj]" (char-category (preceding-char))))

2360 (and (fboundp 'char-charset)

2361 (not (eq (char-charset (preceding-char)) 'ascii)))))

2362 (setq ccol (1+ ccol)))))

2363 (if (and force (> col ccol))

2364 (progn

2365 (insert-char ?\ (- col ccol))

2366 col)

2367 ccol)))

2368

2369 (defun yahtml-fill-paragraph (arg)

2370 (interactive "P")

2371 (let*((case-fold-search t) (p (point)) fill-prefix

2372 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2373 indent

2374 (startp (get 'YaTeX-inner-environment 'point))

2375 (prep (string-match "^pre$" e))

2376 (ps1 (if prep (default-value 'paragraph-start)

2377 paragraph-start))

2378 (ps2 (if prep (concat (default-value 'paragraph-start)

2379 "$\\|^\\s *</?pre>")

2380 paragraph-start)))

2381 (save-excursion

2382 (unwind-protect

2383 (progn

2384 (if prep

2385 (fset 'move-to-column 'yahtml-move-to-column))

2386 (save-excursion

2387 (beginning-of-line)

2388 (indent-to-column (yahtml-this-indent))

2389 (setq fill-prefix

2390 (buffer-substring (point) (point-beginning-of-line)))

2391 (delete-region (point) (point-beginning-of-line)))

2392 (fill-region-as-paragraph

2393 (progn (re-search-backward paragraph-start nil t)

2394 (or (save-excursion

2395 (goto-char (match-beginning 0))

2396 (if (looking-at "<")

2397 (forward-list)

2398 (goto-char (match-end 0))

2399 (skip-chars-forward " \t>"))

2400 (if (looking-at "[ \t]*$")

2401 (progn (forward-line 1) (point))))

2402 (point)))

2403 (progn (goto-char p)

2404 (re-search-forward ps2 nil t)

2405 (match-beginning 0))))

2406 (fset 'move-to-column yahtml-saved-move-to-column)))))

2407

2408 ;(defun yahtml-indent-new-commnet-line ()

2409 ; (unwind-protect

2410 ; (progn

2411 ; (fset 'move-to-column 'yahtml-move-to-column)

2412 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2413 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2414

2415 ;;;

2416 ;;; ---------- indentation ----------

2417 ;;;

2418 (defun yahtml-indent-line ()

2419 "Indent a line (faster wrapper)"

2420 (interactive)

2421 (let (indent)

2422 (if (and (save-excursion

2423 (beginning-of-line) (skip-chars-forward "\t ")

2424 (not (looking-at "<")))

2425 (save-excursion

2426 (forward-line -1)

2427 (while (and (not (bobp)) (looking-at "^\\s *$"))

2428 (forward-line -1))

2429 (skip-chars-forward "\t ")

2430 (setq indent (current-column))

2431 (not (looking-at "<"))))

2432 (progn

2433 (save-excursion

2434 (beginning-of-line)

2435 (skip-chars-forward " \t")

2436 (or (= (current-column) indent)

2437 (YaTeX-reindent indent)))

2438 (and (bolp) (skip-chars-forward " \t")))

2439 (yahtml-indent-line-real))))

2440

2441 (defun yahtml-this-indent ()

2443 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2444 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2445 (excludes

2446 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2447 inenv p col peol (case-fold-search t))

2448 (save-excursion

2449 (beginning-of-line)

2450 (setq inenv (or (yahtml-inner-environment-but excludes t)

2451 "html")

2452 col (get 'YaTeX-inner-environment 'indent)

2453 p (get 'YaTeX-inner-environment 'point)

2454 op nil))

2455 (save-excursion

2456 (cond

2457 ((string-match (concat "^\$" envs "\$") inenv)

2458 (save-excursion

2459 (beginning-of-line)

2460 (skip-chars-forward " \t")

2461 (cond ;lookup current line's tag

2462 ((looking-at (concat "</\$" envs "\$>"))

2463 col)

2464 ((looking-at itms)

2465 (+ col yahtml-environment-indent))

2466 ((and yahtml-hate-too-deep-indentation

2467 (looking-at (concat "<\$" envs "\$")))

2468 (+ col (* 2 yahtml-environment-indent)))

2469 ((and (< p (point))

2470 (string-match itemizing-envs inenv)

2471 (save-excursion

2472 (and

2473 (setq op (point))

2474 (goto-char p)

2475 (re-search-forward itms op t)

2476 (progn

2477 (if yahtml-indent-listing-constant

2478 (setq col (+ (current-column)

2479 (if yahtml-faithful-to-htmllint 1 2)))

2480 (skip-chars-forward "^>")

2481 (skip-chars-forward ">")

2482 (skip-chars-forward " \t")

2483 (setq col (if (looking-at "$")

2484 (+ col yahtml-environment-indent)

2485 (current-column))))))))

2486 col)

2487 (t

2488 (+ col yahtml-environment-indent)))))

2489 (t col)))))

2490

2491 (defun yahtml-indent-line-real ()

2492 "Indent current line."

2493 (interactive)

2494 (YaTeX-reindent (yahtml-this-indent))

2495 (if (bolp) (skip-chars-forward " \t"))

2496 (let (peol col inenv)

2497 (if (and (setq inenv (yahtml-on-begend-p))

2498 (string-match

2499 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2500 (save-excursion

2501 (setq peol (point-end-of-line))

2502 (or (= (char-after (point)) ?<)

2503 (progn (skip-chars-backward "^<") (forward-char -1)))

2504 (setq col (current-column))

2505 (if (and (yahtml-goto-corresponding-begend t)

2506 (> (point) peol)) ;if on the different line

2507 (YaTeX-reindent col))))))

2508

2509 ;(defun yahtml-fill-item ()

2510 ; "Fill item HTML version"

2511 ; (interactive)

2512 ; (let (inenv p fill-prefix peol (case-fold-search t))

2513 ; (setq inenv (or (YaTeX-inner-environment) "html")

2514 ; p (get 'YaTeX-inner-environment 'point))

2515 ; (cond

2516 ; ((string-match "^[uod]l" inenv)

2517 ; (save-excursion

2518 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2519 ; (progn

2520 ; (goto-char (match-end 0))

2521 ; (setq col (current-column)))

2522 ; (error "No <li>, <dt>, <dd>")))

2523 ; (save-excursion

2524 ; (end-of-line)

2525 ; (setq peol (point))

2526 ; (newline)

2527 ; (indent-to-column col)

2528 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2529 ; (delete-region (point) peol)

2530 ; (fill-region-as-paragraph

2531 ; (progn (re-search-backward paragraph-start nil t) (point))

2532 ; (progn (re-search-forward paragraph-start nil t 2)

2533 ; (match-beginning 0)))))

2534 ; (t nil))))

2535

2536 ;;;

2537 ;;; ---------- Lint and Browsing ----------

2538 ;;;

2539 (defun yahtml-browse-menu ()

2540 "Browsing or other external process invokation menu."

2541 (interactive)

2542 (message "J)weblint p)Browse R)eload N)ewpage...")

2543 (let ((c (char-to-string (read-char))))

2544 (cond

2545 ((string-match "j" c)

2546 (yahtml-lint-buffer (current-buffer)))

2547 ((string-match "[bp]" c)

2548 (yahtml-browse-current-file))

2549 ((string-match "r" c)

2550 (yahtml-browse-reload))

2551 ((string-match "n" c)

2552 (call-interactively 'yahtml-newpage)))))

2553

2554 (if (fboundp 'wrap-function-to-control-ime)

2555 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2556

2557 (defvar yahtml-lint-buffer "*weblint*")

2558

2559 (defun yahtml-lint-buffer (buf)

2560 "Call lint on buffer BUF."

2561 (require 'yatexprc)

2562 (interactive "bCall lint on buffer: ")

2563 (setq buf (get-buffer buf))

2564 (YaTeX-save-buffers)

2565 (let ((bcmd (YaTeX-get-builtin "lint")))

2566 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2567 (YaTeX-typeset

2568 (concat (or bcmd yahtml-lint-program)

2569 " " (file-name-nondirectory (buffer-file-name buf)))

2570 yahtml-lint-buffer "lint" "lint")))

2571

2572 (defun yahtml-file-to-url (file)

2573 "Convert local unix file name to URL.

2574 If no matches found in yahtml-path-url-alist, return raw file name."

2575 (let ((list yahtml-path-url-alist) p url)

2576 (if (file-directory-p file)

2577 (setq file (expand-file-name yahtml-directory-index file))

2578 (setq file (expand-file-name file)))

2579 (if (string-match "^[A-Za-z]:/" file)

2580 (progn

2581 ;; (aset file 1 ?|) ;これは要らないらしい…

2582 (setq file (concat "///" file))))

2583 (while list

2584 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2585 (setq url (cdr (car list))

2586 file (substring file (match-end 0))

2587 url (concat url file)

2588 list nil))

2589 (setq list (cdr list)))

2590 (or url (concat "file:" file))))

2591

2592 (defun yahtml-url-to-path (file &optional basedir)

2593 "Convert local URL name to unix file name."

2594 (let ((list yahtml-path-url-alist) url realpath docroot

2595 (dirsufp (string-match "/$" file)))

2596 (setq basedir (or basedir

2597 (file-name-directory

2598 (expand-file-name default-directory))))

2599 (cond

2600 ((string-match "^/" file)

2601 (while list

2602 (if (file-directory-p (car (car list)))

2603 (progn

2604 (setq url (cdr (car list)))

2605 (if (string-match "\$http://[^/]*\$/" url)

2606 (setq docroot (substring url (match-end 1)))

2607 (setq docroot url))

2608 (cond

2609 ((string-match (concat "^" (regexp-quote docroot)) file)

2610 (setq realpath

2611 (expand-file-name

2612 (substring

2613 file

2614 (if (= (aref file (1- (match-end 0))) ?/)

2615 (match-end 0) ; "/foo"

2616 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2617 (car (car list))))))

2618 (if realpath

2619 (progn (setq list nil)

2620 (if (and dirsufp (not (string-match "/$" realpath)))

2621 (setq realpath (concat realpath "/")))))))

2622 (setq list (cdr list)))

2623 realpath)

2624 (t file))))

2625

2626 (defun yahtml-browse-current-file ()

2627 "Call WWW browser on current file."

2628 (interactive)

2629 (basic-save-buffer)

2630 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2631

2632 (defun yahtml-browse-reload ()

2633 "Send `reload' event to netscape."

2634 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2635 (cond

2636 ((string-match "[Nn]etscape" yahtml-www-browser)

2637 (if (get-buffer pb)

2638 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2639 ;;(or (get 'yahtml-netscape-sentinel 'url)

2640 ;; (error "Reload should be called after Browsing."))

2641 (put 'yahtml-netscape-sentinel 'url

2642 (yahtml-file-to-url (buffer-file-name)))

2643 (basic-save-buffer)

2644 (set-process-sentinel

2645 (setq yahtml-browser-process

2646 (start-process

2647 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2648 (format "%s -remote 'reload'" yahtml-www-browser)))

2649 'yahtml-netscape-sentinel))

2650 (t

2651 (message "Sorry, RELOAD is supported only for Netscape.")))))

2652

2653 ;;; ---------- Intelligent newline ----------

2654 (defun yahtml-intelligent-newline (arg)

2655 "Intelligent newline for HTML"

2656 (interactive "P")

2657 (let (env func)

2658 (end-of-line)

2659 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2660 "html")))

2661 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2662 (newline)

2663 (if (and env func (fboundp func))

2664 ;; if intelligent line function is defined, call that

2665 (funcall func)

2666 ;; else do the default action

2667 (if (string-match yahtml-p-prefered-env-regexp env)

2668 (yahtml-insert-p)))))

2669

2670 (defun yahtml-intelligent-newline-ul ()

2671 (interactive)

2672 (yahtml-insert-single "li")

2673 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2674 (yahtml-indent-line))

2675

2676 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2677

2678 (defun yahtml-intelligent-newline-dl ()

2679 (interactive)

2680 (let ((case-fold-search t))

2681 (if (save-excursion

2682 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2683 (get 'YaTeX-inner-environment 'point) t))

2684 (cond

2685 ((match-beginning 2)

2686 (yahtml-insert-single "dd")

2687 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2688 (setq yahtml-last-single-cmd "dt"))

2689 ((match-beginning 3)

2690 (yahtml-insert-single "dt")

2691 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2692 (setq yahtml-last-single-cmd "dd")))

2693 (yahtml-insert-single "dt")

2694 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2695 (setq yahtml-last-single-cmd "dd"))

2696 (yahtml-indent-line)

2697 (and (string-match yahtml-p-prefered-env-regexp "dl")

2698 (string-equal yahtml-last-single-cmd "dt")

2699 (yahtml-insert-p nil))))

2700

2701 (defun yahtml-intelligent-newline-select ()

2702 (interactive)

2703 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2704 (yahtml-indent-line))

2705

2706 (defun yahtml-intelligent-newline-style ()

2707 (interactive)

2708 (if (save-excursion

2709 (and

2710 (re-search-backward "<style\\|<!-- " nil t)

2711 (looking-at "<style")))

2712 (let (c)

2713 (yahtml-indent-line)

2714 (setq c (current-column))

2715 (insert "<!--\n")

2716 (YaTeX-reindent c)

2717 (insert "-->")

2718 (beginning-of-line)

2719 (open-line 1)

2720 (YaTeX-reindent c))))

2721

2722 (defun yahtml-intelligent-newline-head ()

2723 (let ((title (read-string "Document title: "))

2724 (b "<title>") (e "</title>") p)

2725 (yahtml-indent-line)

2726 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2727 (setq p (point))

2728 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2729 (if (string= "" title) (goto-char p))

2730 (setq yahtml-last-begend "body")))

2731

2732 (defun yahtml-intelligent-newline-script ()

2733 (let ((p (point)) b)

2734 (if (save-excursion

2735 (and

2736 (setq b (re-search-backward "<script\\>" nil t))

2737 (re-search-forward

2738 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2739 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2740 c (srcp (re-search-backward "src=" b t)))

2741 (goto-char p)

2742 (yahtml-indent-line)

2743 (setq c (current-column))

2744 (if srcp

2745 nil

2746 (insert "")

2747 (beginning-of-line)

2748 (open-line 1)

2749 (YaTeX-reindent c))))))

2750

2751 (defun yahtml-intelligent-newline-table ()

2752 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2753 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2754 (cond

2755 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2756 (while (and (setq rb (re-search-backward ptn tb t))

2757 (match-beginning 1))

2758 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2759 (goto-char (match-end 0))

2760 (skip-chars-forward " \t\n")

2761 (if (and (search-forward "colspan\\s *=" p t)

2762 (progn

2763 (skip-chars-forward "\"' \t\n")

2764 (looking-at "[0-9]+")))

2765 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2766 (setq cols (1+ cols)))

2767 (goto-char rb)

2768 (setq p (point)))

2769 (if (> cols 0)

2770 (message "%s columns found. %s"

2771 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2772 "New tr?(N) or Duplicate")))

2773 (cond

2774 ((and (> cols 0)

2775 (memq (read-char) '(?d ?D))) ;Duplication mode

2776 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2777 (t ;empty cells

2778 (setq line "<tr>" i 0)

2779 (if (> cols 0)

2780 (while (> cols i)

2781 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2782 "<td></td>"))

2783 th nil i (1+ i)))

2784 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2785 (while (string-match "t\$h\$\\|td" fmt i)

2786 (setq line (concat line (if (match-beginning 1) "<th></th>"

2787 "<td></td>"))

2788 i (match-end 0))))

2789 (setq line (concat line "</tr>"))))

2790 (goto-char cp)

2791 (if th

2792 (message

2793 "Type `%s' to change td from/to th."

2794 (key-description (car (where-is-internal 'yahtml-change-*)))))

2795 (if (string< "" line)

2796 (progn

2797 (insert line)

2798 (goto-char (+ 8 cp))

2799 (yahtml-indent-line)))))))

2800

2801 ;;; ---------- Marking ----------

2802 (defun yahtml-mark-begend ()

2803 "Mark current tag"

2804 (interactive)

2805 (YaTeX-beginning-of-environment)

2806 (let ((p (point)))

2807 (save-excursion

2808 (skip-chars-backward " \t" (point-beginning-of-line))

2809 (if (bolp) (setq p (point))))

2810 (push-mark p t))

2811 (yahtml-goto-corresponding-begend)

2812 (forward-list 1)

2813 (if (eolp) (forward-char 1)))

2814

2815 ;;; ---------- complete marks ----------

2816 (defun yahtml-complete-mark ()

2817 "Complete &gt, &lt, &ampersand, and &quote."

2818 (interactive)

2819 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2820 (let ((c (read-char)))

2821 (setq c (if (or (< c ?0) (> c ?7))

2822 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2823 (- c ?1)))

2824 (if (or (< c 0) (> c 6))

2825 nil

2826 (insert (format "&%s;"

2827 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2828

2829

2830 ;;; ---------- jump to error line ----------

2831 (defun yahtml-prev-error ()

2832 "Jump to previous error seeing lint buffer."

2833 (interactive)

2834 (or (get-buffer yahtml-lint-buffer)

2835 (error "No lint program ran."))

2836 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2837 (yahtml-jump-to-error-line t))

2838

2839 (defun yahtml-jump-to-error-line (&optional sit)

2840 (interactive "P")

2841 (let ((p (point)) (e (point-end-of-line)))

2842 (end-of-line)

2843 (if (re-search-backward yahtml-error-line-regexp nil t)

2844 (let ((f (if (string= "" (YaTeX-match-string 1))

2845 YaTeX-current-file-name

2846 (YaTeX-match-string 1)))

2847 (l (string-to-int (or (YaTeX-match-string 2)

2848 (YaTeX-match-string 3)))))

2849 (if sit (sit-for 1))

2850 (forward-line -1)

2851 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2852 (goto-line l))

2853 (message "No line number usage"))))

2854

2855 ;;; ---------- Style Sheet Support ----------

2856 (defvar yahtml-css-class-alist nil

2857 "Alist of elements vs. their classes")

2858

2859 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2860 (save-excursion

2861 (save-restriction

2862 (narrow-to-region beg end)

2863 (goto-char (point-min))

2864 (let ((alist initial) b e element class a)

2865 (setq b (point))

2866 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2867 (if (match-beginning 2)

2868 (let ((f (YaTeX-buffer-substring

2869 (progn (skip-chars-forward "^\"")(1+ (point)))

2870 (progn (forward-char 1)

2871 (skip-chars-forward "^\"")(point)))))

2872 (if (file-exists-p f)

2873 (setq alist

2874 (append alist (yahtml-css-collect-classes-file f)))))

2875 (setq e (point))

2876 (goto-char b)

2877 (while (re-search-forward ;ちょといい加減なREGEXP

2878 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2879 e t)

2880 (setq element (YaTeX-match-string 1)

2881 class (YaTeX-match-string 2))

2882 ;;if starts with period (match-string 1 is nil),

2883 ;;this is global class

2884 (setq element (downcase (or element "*")))

2885 (if (setq a (assoc element alist))

2886 (or (assoc class (cdr a))

2887 (setcdr a (cons (list class) (cdr a))))

2888 (setq alist (cons (list element (list class)) alist))))

2889 (goto-char (1- e))

2890 (search-forward "}" nil t)

2891 (setq b (point))))

2892 alist))))

2893

2894 (defun yahtml-css-collect-classes-buffer (&optional initial)

2895 (interactive)

2896 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2897

2898 (defun yahtml-css-collect-classes-file (file &optional initial)

2899 (let*((hilit-auto-highlight nil)

2900 (buf (get-buffer-create

2901 (format " *css-collection*%s" (file-name-nondirectory file))))

2902 (cb (current-buffer)))

2903 (unwind-protect

2904 (progn

2905 (set-buffer buf)

2906 (insert-file-contents file)

2907 (cd (or (file-name-directory file) "."))

2908 (yahtml-css-collect-classes-buffer initial))

2909 (if (eq buf cb)

2910 nil

2911 (kill-buffer buf)

2912 (set-buffer cb)))))

2913

2914 (defun yahtml-css-scan-styles ()

2915 (save-excursion

2916 (goto-char (point-min))

2917 (set (make-local-variable 'yahtml-css-class-alist) nil)

2918 (let (b tag type e href alist)

2919 (while (re-search-forward "<\$style\\|link\$" nil t)

2920 (setq b (match-beginning 0)

2921 tag (YaTeX-match-string 1))

2922 (cond

2923 ((string-match "style" tag)

2924 (goto-char b)

2925 (save-excursion (forward-list 1) (setq e (point)))

2926 (cond

2927 ((search-forward "text/css" e 1) ;css definition starts

2928 (setq alist

2929 (yahtml-css-collect-classes-region

2930 (point) (progn (search-forward "</style>") (point))

2931 alist)))))

2932 ((and (string-match "link" tag)

2933 (stringp (setq type (yahtml-get-attrvalue "type")))

2934 (string-match "text/css" type)

2935 (setq href (yahtml-get-attrvalue "href"))

2936 (file-exists-p (yahtml-url-to-path href)))

2937 (setq alist

2938 (yahtml-css-collect-classes-file

2939 (yahtml-url-to-path href) alist))))

2940 (setq yahtml-css-class-alist alist)))))

2941

2942 (defun yahtml-css-get-element-completion-alist (element)

2943 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

2944 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

2945 (and (or alist global)

2946 (append alist global))))

2947

2948 ;;; ---------- ----------

2949

2950 ;;;

2951 ;;hilit19

2952 ;;;

2953 (defvar yahtml-default-face-table

2954 '(

2955 (form black/ivory white/hex-442233 italic)

2956 ))

2957 (defvar yahtml-hilit-patterns-alist

2958 '(

2959 'case-fold

2960 ;; comments

2961 ("" comment)

2962 ;; include&exec

2963 ("" include)

2964 ;; string

2965 (hilit-string-find ?\\ string)

2966 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

2967 ("</?[uod]l>" 0 decl)

2968 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2969 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

2970 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

2971 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

2972 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2973 ))

2974

2975 (defun yahtml-hilit-region-tag (tag)

2976 "Return list of start/end point of <TAG> form."

2977 (if (re-search-forward tag nil t)

2978 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

2979 (elm (YaTeX-match-string 1)))

2980 (skip-chars-forward "^>")

2981 (prog1

2982 (cons (1+ (point))

2983 (progn (re-search-forward (concat "</" elm ">") nil t)

2984 (match-beginning 0)))

2985 (goto-char e0)))))

2986

2987 (defun yahtml-hilit-region-tag-itself (ptn)

2988 "Return list of start/end point of <tag options...> itself."

2989 (if (re-search-forward ptn nil t)

2990 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

2991 (skip-chars-forward "^<>")

2992 (if (eq (char-after (point)) ?<) nil

2993 (prog1

2994 (cons m0 (min (point-max) (1+ (point))))

2995 (goto-char e0))))))

2996

2997 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2998 (and yahtml-use-hilit19

2999 (or (assq 'yahtml-mode hilit-patterns-alist)

3000 (setq hilit-patterns-alist

3001 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3002 hilit-patterns-alist))))

3003 ;;;

3004 ;; for font-lock

3005 ;;;

3006

3007 ; <<STATIC KEYWORDS BELOW NOT USED>>

3008 ;(defvar yahtml-font-lock-keywords

3009 ; '(

3010 ; ;; comments

3011 ; ("" . font-lock-comment-face)

3012 ; ;; include&exec

3013 ; (""

3014 ; 0 font-lock-include-face keep)

3015 ; ;; string

3016 ; ;(hilit-string-find ?\\ string)

3017 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3018 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3019 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3020 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3021 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3022 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3023 ; )

3024 ; "*Defualt font-lock-keywords for yahtml-mode.")

3025 (defvar yahtml-font-lock-keywords

3026 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3027 "Default fontifying patterns for yahtml-mode")

3028

3029 (defun yahtml-font-lock-set-default-keywords ()

3030 (put 'yahtml-mode 'font-lock-defaults

3031 '(yahtml-font-lock-keywords nil t)))

3032

3033 (if yahtml-use-font-lock

3034 (progn

3035 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3036 ;;for those who use both hilit19 and font-lock

3037 (if (eq (car hilit-mode-enable-list) 'not)

3038 (or (member 'yahtml-mode hilit-mode-enable-list)

3039 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3040 (setq hilit-mode-enable-list

3041 (delq 'yahtml-mode hilit-mode-enable-list))))

3042 (yahtml-font-lock-set-default-keywords)))

3043

3044 (defun yahtml-font-lock-recenter (&optional arg)

3045 (interactive "P")

3046 (font-lock-mode -1) ;is stupid, but sure.

3047 (font-lock-mode 1))

3048

3049 (run-hooks 'yahtml-load-hook)

3050 (provide 'yahtml)

3051

3052 ; Local variables:

3053 ; fill-prefix: ";;; "

3054 ; paragraph-start: "^$\\|\\|;;;$"

3055 ; paragraph-separate: "^$\\|\\|;;;$"

3056 ; coding: sjis

3057 ; End: