yatex: 9828ebe7b545 yahtml.el

yatex

view yahtml.el @ 188:9828ebe7b545

Calculation of indentation depth revised. All itemizing elements including dt/dd are assumed as environment.

author	HIROSE Yuuji <yuuji@e.koeki-u.ac.jp>
date	Sat, 17 Dec 2011 12:46:27 +0900
parents	2f183a28d798
children	8abdd3cc87d0

line source

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

3 ;;; Last modified Sat Dec 17 11:17:59 2011 on roy

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 ;;;

146 ;;; と書いておくとそのコマンドを呼びます。

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

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

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

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

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

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

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

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

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

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

157 ;;; * [prefix] } リジョン内の特定文字区切りのレコードを <td> 並びに

158 ;;; 変換します。C-u (universal-argument) 付きで起動

159 ;;; するとtd以外の任意要素で括ります。thdを指定する

160 ;;; と最初の1つだけth，残りすべてをtdで括ります。

161 ;;; * [prefix] ] リジョン内のすべての行をフィールドごとにtdで括り，

162 ;;; さらに各行をtrで括ります。universal-argument を

163 ;;; 付けるとフィールド括りをtd以外に指定できます。

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

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

166 ;;;

167 ;;; [謝辞]

168 ;;;

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

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

171 ;;;

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

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

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

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

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

177 ;;;

178

179

180 (require 'yatexlib)

181 ;;; --- customizable variable starts here ---

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

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

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

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

186 (defvar yahtml-kanji-code 2

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

188 ;;(defvar yahtml-coding-system

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

190 ;; "Kanji coding system")

191 (and (featurep 'mule)

192 (integerp yahtml-kanji-code)

193 (setq yahtml-kanji-code

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

195

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

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

198

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

200 (defvar yahtml-path-url-alist nil

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

202 Ex.

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

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

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

206 "*Directory index file name;

207 Consult your site's WWW administrator.")

208

209 (defvar yahtml-environment-indent 1

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

211

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

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

214 "*Program name to lint HTML file")

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

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

217

218 (defvar yahtml-always-/p t

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

220 (defvar yahtml-always-/li nil

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

222 (defvar yahtml-always-/dt nil

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

224 (defvar yahtml-always-/dd nil

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

226

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

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

229

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

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

232

233 (defvar yahtml-prefer-upcases nil

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

235

236 (defvar yahtml-prefer-upcase-attributes nil

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

238

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

240

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

242 "*Server access file name for apache")

243

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

245

246 (defvar yahtml-image-inspection-bytes 500000

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

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

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

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

251 %f: filename")

252

253 (defvar yahtml-faithful-to-htmllint (not yahtml-always-/li)

254 "*Non-nil doesn't put space after opening tags.")

255 (defvar yahtml-error-line-regexp

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

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

258

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

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

261 (defvar yahtml-escape-chars 'ask

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

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

264 at each reserved chars.")

265

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

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

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

269

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

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

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

273

274 (defvar yahtml-mode-abbrev-table nil

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

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

277

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

279 "*Boundary regexp for indentation calculation.")

280

281 (defvar yahtml-html4-strict t

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

283 Completing read for obsoleted attributes disabled.")

284

285 ;;; --- customizable variable ends here ---

286 (defvar yahtml-prefix-map nil)

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

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

289 (defvar yahtml-shell-command-option

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

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

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

293

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

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

296 (YaTeX-define-key

297 key

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

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

300 map))

301

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

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

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

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

306

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

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

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

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

311 (if YaTeX-inhibit-prefix-letter nil

312 (yahtml-define-begend-region-key

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

314

315 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

328 (let ((map yahtml-prefix-map))

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

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

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

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

333 (and YaTeX-emacs-19 window-system

334 (progn

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

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

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

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

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

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

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

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

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

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

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

346 (if YaTeX-no-begend-shortcut

347 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

382 (YaTeX-define-key "}" 'yahtml-td-region map)

383 (YaTeX-define-key "]" 'yahtml-tr-region map)

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

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

386 (substitute-all-key-definition

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

388 (substitute-all-key-definition

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

390

391 (if yahtml-lint-buffer-map nil

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

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

394

395

396 (defvar yahtml-paragraph-start

397 (concat

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

399 "*Regexp of html paragraph separater")

400 (defvar yahtml-paragraph-separate

401 (concat

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

403 "*Regexp of html paragraph separater")

404 (defvar yahtml-syntax-table nil

405 "*Syntax table for yahtml-mode")

406

407 (if yahtml-syntax-table nil

408 (setq yahtml-syntax-table

409 (make-syntax-table (standard-syntax-table)))

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

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

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

413

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

415 "Regexp of constituent of html commands.")

416

417 ;;; Completion tables for `form'

418 (defvar yahtml-form-table

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

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

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

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

423

424 (defvar yahtml-env-table

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

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

427 ("OrderedList" . "ol")

428 ("UnorderedList" . "ul")

429 ("DefinitionList" . "dl")

430 ("Preformatted" . "pre")

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

432 ("address") ("button")

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

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

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

436 ))

437

438 (if yahtml-html4-strict

439 (setq yahtml-env-table

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

441

442 ;(defvar yahtml-itemizing-regexp

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

444 ; "Regexp of itemizing forms")

445

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

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

448

449 ;;; Completion tables for typeface designator

450 (and yahtml-always-/p

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

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

453 (and yahtml-always-/li

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

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

456 (and yahtml-always-/dt

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

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

459 (and yahtml-always-/dd

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

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

462

463 (defvar yahtml-typeface-table

464 (append

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

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

467 ("sup") ("sub") ("span") ("abbr"))

468 (if (not yahtml-html4-strict)

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

470 yahtml-env-table)

471 "Default completion table of typeface designator")

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

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

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

475

476 (defvar yahtml-single-cmd-table

477 '(("hr") ("br") ("option")

478 ("HorizontalRule" . "hr")

479 ("BreakLine" . "br")

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

481 ("!--#exec")

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

483 ("!--#include")

484 ;; ("Item" . "li")

485 ;; ("DefineTerm" . "dt")

486 ;; ("Description" . "dd")

487 ;; ("dd") ("dt") ("li")

488 )

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

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

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

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

493

494 (defvar yahtml-current-completion-type nil

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

496

497 (defvar yahtml-struct-name-regexp

498 (concat

499 "\\<\\("

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

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

502 "\\)\\b")

503 "Regexp of structure beginning.")

504

505 (defvar yahtml-closable-regexp

506 (concat

507 "\\<\\("

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

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

510 "\\)\\b")

511 "Regexp of any closable elemnts.")

512

513 (defvar yahtml-indent-listing-constant t

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

515 T for static indentation depth")

516

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

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

519

520

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

522 (cond

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

524 buffer-file-name)

525 (let ((dir default-directory)

526 charset af ext (ldir "")

527 line

528 (case-fold-search t)

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

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

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

532 (while (and dir

533 (not (string= dir ldir))

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

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

536 (if (file-exists-p af)

537 (save-excursion

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

539 (save-excursion

540 (goto-char (point-min))

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

542 (setq line (buffer-substring

543 (point-beginning-of-line)

544 (point-end-of-line))

545 dir nil)))

546 (kill-buffer (current-buffer))))

547 (if dir

548 (setq ldir dir

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

550 dir (file-name-directory dir))))

551 line))

552 (t nil)))

553

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

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

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

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

558 (case-fold-search t)

559 line

560 charset)

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

562 (progn

563 (string-match ptn line)

564 (setq charset

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

566 (cond

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

568 (setq charset 2))

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

570 (setq charset 3))

571 ((string-match "shift_jis" charset)

572 (setq charset 1))

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

574 (setq charset 4))

575 (t (setq charset nil)))

576 (setq dir "")))

577 (if (featurep 'mule)

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

579 charset))

580

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

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

583 x index-list)

584 ;;s/\\s *$//;

585 (if line

586 (progn

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

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

589 (while (string< "" line)

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

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

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

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

594 line "")))

595 (or (nreverse index-list)

596 (if (listp yahtml-directory-index)

597 yahtml-directory-index

598 (list yahtml-directory-index)))))))

599

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

601 (defun yahtml-mode ()

602 (interactive)

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

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

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

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

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

608 (cond

609 ((null coding) nil)

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

611 (setq buffer-file-coding-system

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

613 (save-excursion

614 (goto-char (point-min))

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

616 coding)))

617 ((featurep 'mule)

618 (set-file-coding-system coding))

619 ((boundp 'NEMACS)

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

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

622 (setq major-mode 'yahtml-mode

623 mode-name "yahtml"

624 YaTeX-current-file-name (file-name-nondirectory

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

626 local-abbrev-table yahtml-mode-abbrev-table)

627 (mapcar

628 (function (lambda (x)

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

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

631 (boundp (cdr x)))

632 (symbol-value (cdr x))

633 (cdr x)))))

634 '((YaTeX-ec . "")

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

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

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

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

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

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

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

642 (paragraph-start . yahtml-paragraph-start)

643 (paragraph-separate . yahtml-paragraph-separate)

644 (comment-start . "")

645 (comment-start-skip . comment-start)

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

647

648 (if yahtml-use-font-lock

649 (progn

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

651 (or (featurep 'xemacs)

652 (progn

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

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

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

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

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

658 (font-lock-fontify-buffer)))))

659 (set-syntax-table yahtml-syntax-table)

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

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

662 (yahtml-css-scan-styles)

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

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

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

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

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

668

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

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

671 font-lock-defaults)

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

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

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

675

676 (defun yahtml-version ()

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

678 (interactive)

679 (message

680 (concat "Yet Another HTML-mode "

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

682 " Revision "

683 yahtml-revision-number)))

684

685 (defun yahtml-quit ()

686 (interactive)

687 (and yahtml-mode-old-mode

688 (fboundp yahtml-mode-old-mode)

689 (funcall yahtml-mode-old-mode)))

690

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

692 (cond

693 ((featurep 'xemacs)

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

695 (set keymap nil)

696 (mapcar

697 (function

698 (lambda (bind)

699 (setq bind (cdr bind))

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

701 (setcar (cdr bind) 'progn))

702 (if (stringp (car (cdr bind)))

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

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

705 (symbol-value keymap))))))

706 bindlist)

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

708 (t

709 (mapcar

710 (function

711 (lambda (bind)

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

713 bindlist))))

714

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

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

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

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

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

720

721 ;;; Variables for mosaic url history

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

723 (defvar yahtml-urls-private nil)

724 (defvar yahtml-urls-local nil)

725

726 (cond

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

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

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

730 (YaTeX-define-menu

731 'yahtml-menu-map-sectioning

732 (nreverse

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

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

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

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

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

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

739 )))

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

741 (YaTeX-define-menu

742 'yahtml-menu-map-logical

743 (nreverse

744 '((em "Embolden" .

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

746 (dfn "Define a word" .

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

748 (cite "Citation" .

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

750 (code "Code" .

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

752 (kbd "Keyboard" .

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

754 (samp "Sample display" .

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

756 (strong "Strong" .

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

758 (VAR "Variable notation" .

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

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

761 (YaTeX-define-menu

762 'yahtml-menu-map-typeface

763 (nreverse

764 '((b "Bold" .

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

766 (i "Italic" .

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

768 (tt "Typewriter" .

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

770 (u "Underlined" .

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

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

773 (YaTeX-define-menu

774 'yahtml-menu-map-listing

775 (nreverse

776 '((ul "Unordered" .

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

778 (ol "Ordered" .

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

780 (dl "Definition" .

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

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

783 (YaTeX-define-menu

784 'yahtml-menu-map-item

785 (nreverse

786 '((li "Simple item" .

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

788 (dt "Define term" .

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

790 (dd "Description of term" .

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

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

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

794 (YaTeX-define-menu

795 'yahtml-menu-map

796 (nreverse

797 (list

798 (cons (list 'sect "Sectioning")

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

800 (cons (list 'list "Listing")

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

802 (cons (list 'item "Item")

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

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

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

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

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

808 (if (featurep 'xemacs)

809 (add-hook 'yahtml-mode-hook

810 '(lambda ()

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

812 (progn

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

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

815

816 ;;; ----------- Completion ----------

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

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

819 "Insert <cmd> ... </cmd>."

820 (interactive "P")

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

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

823 (cmd

824 (or env

825 (YaTeX-cplread-with-learning

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

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

828 (bolp (save-excursion

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

830 (cc (current-column)))

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

832 (setq yahtml-last-begend

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

834 yahtml-last-begend))

835 (setq cmd yahtml-last-begend)

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

837 (if region

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

839 ;; to enable continuous regioning by another environment

840 (let ((beg (region-beginning))

841 (end (region-end))

842 (addin (yahtml-addin cmd)))

843 (save-excursion

844 (goto-char end)

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

846 (goto-char beg)

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

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

849 (save-excursion

850 (insert "\n")

851 (indent-to-column cc)

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

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

854 (newline)

855 (yahtml-intelligent-newline nil))

856 (yahtml-indent-line))))

857

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

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

860 (interactive)

861 (yahtml-insert-begend t))

862

863

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

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

866 (interactive)

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

868 (or form

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

870 (setq form

871 (YaTeX-cplread-with-learning

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

873 'yahtml-form-table 'yahtml-user-form-table

874 'yahtml-tmp-form-table))))

875 (let ((p (point)) q)

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

877 (setq yahtml-last-form form)

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

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

880 ;;(indent-relative-maybe)

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

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

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

884

885 (defun yahtml-read-css (alist)

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

887 (minibuffer-completion-table alist))

888 (read-from-minibuffer

889 (substitute-command-keys

890 (if YaTeX-japan

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

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

893 nil YaTeX-minibuffer-completion-map nil)))

894

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

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

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

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

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

900 (defun yahtml-newpage (file ov)

901 "Create newpage via newpage script"

902 (interactive

903 (list

904 (let (insert-default-directory)

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

906 current-prefix-arg))

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

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

909 (insert (substring

910 (YaTeX-command-to-string

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

912 0 -1)))

913

914 ;;; ---------- Add-in ----------

915 (defun yahtml-addin (form)

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

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

918 (concat

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

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

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

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

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

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

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

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

927 (string< "" s))

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

929 ""))))

930

931 (defvar yahtml-completing-buffer nil)

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

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

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

935 (let (list end)

936 (save-excursion

937 (set-buffer yahtml-completing-buffer)

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

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

940 (save-excursion

941 (goto-char (point-min))

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

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

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

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

946 (setq end (match-end 0))

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

948 (yahtml-on-assignment-p)

949 (progn

950 (goto-char end)

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

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

953 (setq list (cons

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

955 list))))

956 list))))

957

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

959 (if yahtml-url-completion-map nil

960 (setq yahtml-url-completion-map

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

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

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

964

965 (defun yahtml-complete-url ()

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

967 (interactive)

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

969 (lim (YaTeX-minibuffer-begin))

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

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

972 (cond

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

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

975 listfunc (list 'lambda nil

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

977 beg min))

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

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

980 (progn

981 (setq path (substring initial 0 beg))

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

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

984 (setq initial (substring initial beg))

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

986 cmpl (try-completion initial labels)

987 listfunc (list 'lambda ()

988 (list 'all-completions

989 initial (list 'quote labels)))

990 beg (+ min beg)))

991 (t

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

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

994 initial))

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

996 file (file-name-nondirectory path)

997 initial file

998 cmpl (file-name-completion file dir)

999 listfunc (list 'lambda nil

1000 (list 'file-name-all-completions

1001 file dir))

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

1003 (cond

1004 ((stringp cmpl)

1005 (if (string= initial cmpl)

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

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

1008 (princ

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

1010 (delete-region (point) beg)

1011 (insert cmpl)))

1012 ((null cmpl)

1013 (ding))

1014 ((eq t cmpl)

1015 (save-excursion

1016 (unwind-protect

1017 (progn

1018 (goto-char p)

1019 (insert " [Sole completion]"))

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

1021

1022 ;

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

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

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

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

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

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

1029 ;

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

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

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

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

1034 (defvar yahtml-unsafe-chars-regexp

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

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

1037 ;

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

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

1040 ;

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

1042 ; "$" | ","

1043 (defvar yahtml-unreserved-chars-regexp

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

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

1046 Not used yet.")

1047

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

1049 "Translate reserved chars to URL encoded string."

1050 (let ((p 0) (target "")

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

1052 (cond

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

1054 (t

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

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

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

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

1059 (setq target (concat target

1060 (substring str 0 p)

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

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

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

1064 (concat target str)))))

1065

1066 (defun yahtml-unescape-string (str)

1067 "Untranslate reserved URL-encoded string."

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

1069 (unwind-protect

1070 (progn

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

1072 (setq target (concat target

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

1074 p (match-end 0)

1075 c (YaTeX-hex (substring

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

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

1078 (concat target (substring str p)))

1079 (store-match-data md))))

1080

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

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

1083 (interactive "r")

1084 (save-excursion

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

1086 (goto-char beg)

1087 (while (and (< (point) e)

1088 (re-search-forward

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

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

1091 (sit-for 0)

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

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

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

1095 ; (unwind-protect

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

1097 ; (save-excursion

1098 ; (backward-char 1)

1099 ; (delete-backward-char 4))

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

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

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

1103 (progn

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

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

1106 (set-marker e nil))))

1107 ;; ab%defgls/.|

1108

1109 (defun yahtml:a ()

1110 "Add-in function for <a>"

1111 (let ((href ""))

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

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

1114 href (yahtml-escape-chars-string

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

1116 (prog1

1117 (concat (yahtml-make-optional-argument

1118 "href" href)

1119 (yahtml-make-optional-argument

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

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

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

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

1124 (YaTeX-update-table

1125 (list href)

1126 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1127

1128 (defvar yahtml-parameters-completion-alist

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

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

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

1132 ("src" . file) ("file" . file)

1133 ("background" . file)

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

1135 ("method" ("POST") ("GET"))

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

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

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

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

1140 ("http-equiv" ("Refresh"))))

1141

1142 (defvar yahtml-link-types-alist

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

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

1145 ("subsection") ("appendix") ("help") ("bookmark")))

1146

1147 (defvar yahtml-content-types-alist

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

1149 ("text/sgml") ("text/xml")

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

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

1152 ("application/java")

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

1154 "Alist of content-types")

1155

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

1157 (let* ((alist

1158 (cdr-safe (assoc (downcase par)

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

1160 (prompt (concat par ": "))

1161 v)

1162 (cond

1163 ((eq alist 'file)

1164 (let ((insert-default-directory))

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

1166 ((eq alist 'command)

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

1168 (read-shell-command prompt)

1169 (read-string prompt)))

1170 ((and alist (symbolp alist))

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

1172 (alist

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

1174 (t

1175 (read-string prompt default)))))

1176

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

1178 "Make optional argument string."

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

1180 ""

1181 (concat " "

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

1183 "=\"" arg "\"")))

1184

1185 (defun yahtml:html ()

1186 "Add-in for <html>"

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

1188 (yahtml-make-optional-argument

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

1190

1191 (defun yahtml:head ()

1192 "Add-in for <head>"

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

1194 "")

1195

1196 (defun yahtml:body ()

1197 "Add-in function for <body>"

1198 (cond

1199 (yahtml-html4-strict nil)

1200 (t

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

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

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

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

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

1206 (concat

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

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

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

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

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

1212

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

1214 "Make CSS property definitions in style attribute."

1215 (mapconcat

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

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

1218 (delq nil proplist)

1219 " "))

1220

1221 (defun yahtml:img ()

1222 "Add-in function for <img>"

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

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

1225 alt

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

1227 (l yahtml-prefer-upcase-attributes)

1228 info width height bytes comments)

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

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

1231 (car info)

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

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

1234 bytes (car (cdr (cdr info)))

1235 comments (nth 4 info)))

1236 (if info

1237 (setq alt

1238 (YaTeX-replace-formats

1239 yahtml:img-default-alt-format

1240 (list (cons "x" width)

1241 (cons "y" height)

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

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

1244 (cons "c" (car comments))))))

1245

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

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

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

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

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

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

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

1253 (if yahtml-html4-strict

1254 (yahtml-make-optional-argument

1255 "style"

1256 (if (or brd alg)

1257 (yahtml-make-style-parameter

1258 (list

1259 (if (string< "" alg)

1260 (cons "align" alg))

1261 (if (string< "" brd)

1262 (cons "border"

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

1264 (concat

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

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

1267

1268 (defun yahtml-file-truename (file)

1269 (cond

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

1271 (t (let ((new file))

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

1273 (not (equal new file)))

1274 (setq file new))

1275 file))))

1276

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

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

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

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

1281 (let ((mlt 1)

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

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

1284 (value 0))

1285 (while (> length 0)

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

1287 pos (+ pos direc)

1288 mlt (* mlt 256)

1289 length (1- length)))

1290 value))

1291

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

1293 "Return the information on the image file FILE.

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

1295 (save-excursion

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

1297 width height bytes depth comment

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

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

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

1301 (seekpoint 1)

1302 c1 c2 c3 c4 beg end

1303 (case-fold-search nil))

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

1305 (set-buffer tmpbuf)

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

1307 (erase-buffer)

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

1309 (unwind-protect

1310 (progn

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

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

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

1314 (YaTeX-insert-file-contents

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

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

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

1318 c2 (char-after 2)

1319 c3 (char-after 3)

1320 c4 (char-after 4))

1321 (cond

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

1323 ;;JPEG images need JPEG markers inspection

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

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

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

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

1328 (catch 'exit

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

1330 (cond

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

1332 ;maybe corrupted, exit from loop

1333 (throw 'exit t))

1334 ((memq

1335 (char-after (1+ seekpoint))

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

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

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

1339 ;;found!

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

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

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

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

1344 ;; JPEG comment area

1345 (setq beg (+ seekpoint 2 2)

1346 end (+ seekpoint

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

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

1349 (t ;other markers

1350 nil)) ;just skip it

1351 (setq seekpoint (+ seekpoint 2)

1352 seekpoint (+ seekpoint

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

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

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

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

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

1358 height (yahtml-hex-value 20 4)

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

1360 ((looking-at "GIF8")

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

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

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

1364 ((looking-at "BM")

1365 ;;# OS/2, Windoze BMP files

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

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

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

1369 (cond

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

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

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

1373 (t

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

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

1376 (message "")

1377 (kill-buffer tmpbuf))

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

1379

1380 (defun yahtml:form ()

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

1382 (concat

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

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

1385 "\""

1386 (yahtml-make-optional-argument

1387 (if yahtml-prefer-upcase-attributes "ENCTYPE" "enctype")

1388 (completing-read

1389 "Enctype: "

1390 '(("application/x-www-form-urlencoded") ("multipart/form-data"))))

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

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

1393

1394 (defun yahtml:select ()

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

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

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

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

1399

1400 (defun yahtml:ol ()

1401 "Add-in function for <ol>"

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

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

1404 (type (completing-read

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

1406 (concat

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

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

1409 (defun yahtml:ul ()

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

1411 (defun yahtml:dl ()

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

1413 (defun yahtml:dt ()

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

1415

1416 (defun yahtml:p ()

1417 (if yahtml-html4-strict nil

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

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

1420

1421 (defvar yahtml-input-types

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

1423 ("reset") ("image") ("hidden") ("file")))

1424

1425 (defun yahtml:input ()

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

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

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

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

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

1431 yahtml-input-types nil t)

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

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

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

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

1436 (concat

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

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

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

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

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

1442

1443 (defun yahtml:textarea ()

1444 "Add-in function for `textarea'"

1445 (interactive)

1446 (let (name rows cols)

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

1448 cols (read-string "Columns: ")

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

1450 (concat

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

1452 "\"" name "\"")

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

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

1455

1456 (defun yahtml:table ()

1457 "Add-in function for `table'"

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

1459 (a (yahtml-read-parameter

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

1461 (if yahtml-html4-strict

1462 (yahtml-make-optional-argument

1463 "style"

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

1465 (yahtml-make-style-parameter

1466 (append

1467 (if (string< "" b)

1468 (list

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

1470 (cons "border-collapse" "collapse")))

1471 (if (string< "" a)

1472 (cond

1473 ((string-match "right" a)

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

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

1476 ((string-match "center" a)

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

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

1479 (concat

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

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

1482

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

1484 (defun yahtml:caption ()

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

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

1487 (if yahtml-html4-strict

1488 (yahtml-make-optional-argument

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

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

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

1492

1493 (defun yahtml:font ()

1494 "Add-in function for `font'"

1495 (concat

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

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

1498

1499 (defun yahtml:style ()

1500 "Add-in function for `style'"

1501 (yahtml-make-optional-argument

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

1503

1504 (defun yahtml:script ()

1505 "Add-in function for `script'"

1506 (concat

1507 (yahtml-make-optional-argument

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

1509 (yahtml-make-optional-argument

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

1511

1512 (defun yahtml:tr ()

1513 "Add-in function for `tr'"

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

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

1516 "")

1517

1518 (defun yahtml:link ()

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

1520 (let (rel rev type href)

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

1522 (cond

1523 ((equal rel "")

1524 (concat (yahtml-make-optional-argument

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

1526 (yahtml-make-optional-argument

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

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

1529 )))

1530 ((string-match "stylesheet" rel)

1531 (concat

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

1533 (yahtml-make-optional-argument

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

1535 (progn

1536 (setq href

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

1538 (if (string< "" href)

1539 (progn

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

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

1542 (setq yahtml-css-class-alist

1543 (yahtml-css-collect-classes-file

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

1545 (message "")

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

1547 (t

1548 (concat

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

1550 (yahtml-make-optional-argument

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

1552 (yahtml-make-optional-argument

1553 "href"

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

1555

1556 (defvar yahtml:meta-names

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

1558

1559 (defun yahtml:meta ()

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

1561 "name"

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

1563 http-equiv content)

1564 (if (string= "" name)

1565 (if (string-match

1566 "Content-type"

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

1568 "http-equiv"

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

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

1571 "See docs/qanda")

1572 (concat http-equiv

1573 (yahtml-make-optional-argument

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

1575 (concat

1576 name

1577 (yahtml-make-optional-argument

1578 "content"

1579 (cond

1580 ((string-match "date" name)

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

1582 ((string-match "author" name)

1583 (read-string "Author: "

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

1585 (user-full-name)

1586 (user-login-name))))

1587 ((string-match "GENERATOR" name)

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

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

1590 (message "Thank you!"))

1591 content)

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

1593

1594 (defun yahtml:br ()

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

1596

1597 (defun yahtml:object ()

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

1599 data classid)

1600 (cond

1601 ((string-match "java" codetype)

1602 (let ((completion-ignored-extensions

1603 ;;any extensions except ".class"

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

1605 (setq classid (concat "java:"

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

1607 (concat

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

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

1610 (yahtml-make-optional-argument

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

1612 (yahtml-make-optional-argument

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

1614 (yahtml-make-optional-argument

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

1616 (t

1617 ""))))

1618

1619 (defun yahtml:abbr ()

1620 "Add-in function for abbr."

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

1622

1623 (defun yahtml:button ()

1624 (concat

1625 (yahtml-make-optional-argument

1626 "name" (yahtml-read-parameter "name"))

1627 (yahtml-make-optional-argument

1628 "type" (yahtml-read-parameter

1629 "type" "button" '(("submit")("reset")("button"))))

1630 (yahtml-make-optional-argument

1631 "value" (yahtml-read-parameter "value"))))

1632

1633 ;;; ---------- Simple tag ----------

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

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

1636 (interactive "P")

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

1638 (or tag

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

1640 (setq tag

1641 (YaTeX-cplread-with-learning

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

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

1644 'yahtml-typeface-table 'yahtml-user-typeface-table

1645 'yahtml-tmp-typeface-table))))

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

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

1648 (setq yahtml-last-typeface-cmd tag

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

1650 (if region-mode

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

1652 (save-excursion

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

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

1655 (exchange-point-and-mark)

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

1657 (message "No mark set now"))

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

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

1660

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

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

1663 (interactive)

1664 (yahtml-insert-tag t tag))

1665

1666 (defvar yahtml-need-single-closer nil) ;for test

1667 (defun yahtml-insert-single (cmd)

1668 "Insert <CMD>."

1669 (interactive

1670 (list

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

1672 (YaTeX-cplread-with-learning

1673 (format "Command%s: "

1674 (if yahtml-last-single-cmd

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

1676 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1679 (setq yahtml-last-single-cmd

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

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

1682 yahtml-last-single-cmd))

1683 (insert (format "<%s%s%s>"

1684 cmd

1685 (yahtml-addin cmd)

1686 (if (and yahtml-need-single-closer

1687 (assoc cmd '(("br")("hr"))))

1688 " /" "")))

1689 (if (assoc cmd yahtml-env-table)

1690 (save-excursion (insert (format "</%s>" cmd)))))

1691

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

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

1694 (interactive "P")

1695 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")

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

1697

1698 (defun yahtml-insert-amps (arg)

1699 "Insert char-entity references via ampersand"

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

1701 (interactive "P")

1702 (let*((mess "") c

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

1704 yahtml-entity-reference-chars-alist))

1705 (l list))

1706 (while l

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

1708 l (cdr l)))

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

1710 (setq c (read-char))

1711 (cond

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

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

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

1715 (insert "&;")

1716 (forward-char -1))

1717 ((equal c ? )

1718 (insert ?&))

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

1720

1721 (defun yahtml:!--\#include ()

1722 (let ((file (yahtml-read-parameter "file" "")))

1723 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1724

1725 (defun yahtml:!--\#exec ()

1726 (format "cmd=\"%s\"--"

1727 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))

1728

1729 ;;; ---------- Jump ----------

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

1731 "Check if point is on href clause."

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

1733 (save-excursion

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

1735 (save-excursion

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

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

1738 (setq e (point)))

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

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

1741 (search-forward "href" e t)

1742 (search-forward "=" e t)

1743 (progn

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

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

1746 (< p (match-end 0))

1747 (yahtml-unescape-string (YaTeX-match-string 1))))))

1748

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

1750 (cond

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

1752 (set-process-buffer proc nil))

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

1754 (let ((cb (current-buffer)))

1755 (set-buffer (process-buffer proc))

1756 (goto-char (point-min))

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

1758 (progn

1759 (message "Starting netscape...")

1760 (start-process

1761 "browser" (process-buffer proc)

1762 shell-file-name yahtml-shell-command-option

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

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

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

1766 (set-buffer cb)))))

1767

1768 (defvar yahtml-browser-process nil)

1769

1770 (defun yahtml-browse-html (href)

1771 "Call WWW Browser to see HREF."

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

1773 (cond

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

1775 (if (get-buffer pb)

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

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

1778 (set-process-sentinel

1779 (setq yahtml-browser-process

1780 (start-process

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

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

1783 'yahtml-netscape-sentinel))

1784 ((and (string-match

1785 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

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

1787 (if (get-buffer pb)

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

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

1790 (set-process-sentinel

1791 (setq yahtml-browser-process

1792 (start-process

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

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

1795 'yahtml-netscape-sentinel))

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

1797 (w3-fetch href))

1798 ((stringp yahtml-www-browser)

1799 (if (and yahtml-browser-process

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

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

1802 (setq yahtml-browser-process

1803 (start-process

1804 "browser" "* WWW Browser *"

1805 shell-file-name yahtml-shell-command-option

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

1807 (t

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

1809

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

1811 "Go to corresponding name."

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

1813 (if href

1814 (cond

1815 ((string-match "^\$ht\\|f\$tps?:" href)

1816 (yahtml-browse-html href))

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

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

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

1820 (if (string< "" file)

1821 (progn

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

1823 (or (catch 'dirindex

1824 (mapcar

1825 (function

1826 (lambda (f)

1827 (if (file-exists-p (concat file f))

1828 (throw 'dirindex

1829 (setq file (concat file f))))))

1830 (yahtml-get-directory-index))

1831 nil)

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

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

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

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

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

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

1838 (if name

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

1840 t)))))

1841

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

1843 "Jump to html's named tag."

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

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

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

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

1848

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

1850 "Check if point is on begend clause."

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

1852 (save-excursion

1853 (goto-char p)

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

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

1856 (looking-at

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

1858 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1859 (condition-case nil

1860 (forward-list 1)

1861 (error nil))

1862 (< p (point)))

1863 (YaTeX-match-string 1)))))

1864

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

1866 "Go to corresponding opening/closing tag.

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

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

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

1870 (cond

1871 (cmd

1872 (setq m0 (match-beginning 0))

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

1874 (setq cmd (substring cmd 1)

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

1876 func 're-search-backward)

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

1878 func 're-search-forward))

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

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

1881 nil

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

1883 (if (< nest 0)

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

1885 (funcall

1886 (if noerr 'message 'error)

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

1888 (goto-char p)

1889 nil))

1890 (t nil))))

1891

1892 (defun yahtml-current-tag ()

1893 "Return the current tag name including #exec and #include."

1894 (save-excursion

1895 (let ((p (point)) b tag)

1896 (or (bobp)

1897 (looking-at "<")

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

1899 (setq b (point))

1900 (skip-chars-forward "<")

1901 (setq tag (YaTeX-buffer-substring

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

1903 (goto-char b)

1904 (forward-list 1)

1905 (and (< p (point)) tag))))

1906

1907 (defun yahtml-get-attrvalue (attr)

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

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

1910 (save-excursion

1911 (or (looking-at "<")

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

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

1914 (if (and

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

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

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

1918 (YaTeX-match-string 1)))))

1919

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

1921 "View image on point"

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

1923 (if (and tag

1924 (string-match "img" tag)

1925 (setq image

1926 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1927 (progn

1928 (message "Invoking %s %s..." yahtml-image-viewer image)

1929 (start-process

1930 "Viewer" " * Image Viewer *"

1931 shell-file-name yahtml-shell-command-option ;"-c"

1932 (concat yahtml-image-viewer " " image))

1933 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1934

1935 (defun yahtml-goto-corresponding-source (&optional other)

1936 "Goto applet's or script's source."

1937 (let ((env (yahtml-current-tag)) s (p (point)))

1938 (cond

1939 ((string-match "applet" env)

1940 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1941 (progn

1942 (setq s (YaTeX-match-string 1)

1943 s (concat

1944 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1945 ".java"))

1946 (if other (YaTeX-switch-to-buffer-other-window s)

1947 (YaTeX-switch-to-buffer s))

1948 s) ;return source file name

1949 (message "No applet source specified")

1950 (sit-for 1)

1951 nil))

1952 ((string-match "script" env)

1953 (if (setq s (yahtml-get-attrvalue "src"))

1954 (progn

1955 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1956 'YaTeX-switch-to-buffer)

1957 (yahtml-url-to-path s))

1958 s)))

1959 ((string-match "!--#include" env)

1960 (cond

1961 ((setq s (yahtml-get-attrvalue "file")) ;

1962 (if other (YaTeX-switch-to-buffer-other-window s)

1963 (YaTeX-switch-to-buffer s))

1964 s)

1965 ((setq s (yahtml-get-attrvalue "virtual"));

1966 (setq s (yahtml-url-to-path s))

1967 (if other (YaTeX-switch-to-buffer-other-window s)

1968 (YaTeX-switch-to-buffer s))

1969 s)))

1970 ((and (string-match "!--#exec" env)

1971 (setq s (yahtml-get-attrvalue "cmd")))

1972 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1973 (let ((b " *yahtmltmp*")) ;peek a little

1974 (unwind-protect

1975 (progn

1976 (set-buffer (get-buffer-create b))

1977 (YaTeX-insert-file-contents s nil 0 100)

1978 (if (looking-at "#!")

1979 (if other (YaTeX-switch-to-buffer-other-window s)

1980 (YaTeX-switch-to-buffer s))))

1981 (kill-buffer (get-buffer b)))

1982 (get-file-buffer s))))))

1983

1984 (defun yahtml-goto-corresponding-* (&optional other)

1985 "Go to corresponding object."

1986 (interactive "P")

1987 (cond

1988 ((yahtml-goto-corresponding-href other))

1989 ((yahtml-goto-corresponding-img))

1990 ((yahtml-goto-corresponding-source other))

1991 ((yahtml-goto-corresponding-begend))

1992 (t (message "I don't know where to go."))))

1993

1994 (defun yahtml-goto-corresponding-*-other-window ()

1995 "Go to corresponding object."

1996 (interactive)

1997 (yahtml-goto-corresponding-* t))

1998

1999 (defun yahtml-visit-main ()

2000 "Go to parent file from where you visit current file."

2001 (interactive)

2002 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2003

2004 ;;; ---------- killing ----------

2005 (defun yahtml-kill-begend (&optional whole)

2006 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2007 (if tag

2008 (save-excursion

2009 (or (looking-at "<")

2010 (progn (skip-chars-backward "^<") (forward-char -1)))

2011 (setq p (point))

2012 (yahtml-goto-corresponding-begend)

2013 (or (looking-at "<")

2014 (progn (skip-chars-backward "^<") (forward-char -1)))

2015 (if (< (point) p) ;if on the opening tag

2016 (progn (setq q p p (point))

2017 (goto-char q))

2018 (setq q (point))) ;now q has end-line's (point)

2019 (if (not whole)

2020 (kill-region

2021 (progn (skip-chars-backward " \t")

2022 (if (setq bbolp (bolp)) (point) q))

2023 (progn (forward-list 1)

2024 (setq r (point))

2025 (skip-chars-forward " \t")

2026 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2027 (goto-char p)

2028 (skip-chars-backward " \t")

2029 (if (not whole)

2030 (progn

2031 (kill-append

2032 (buffer-substring

2033 (setq p (if (setq bbolp (bolp)) (point) p))

2034 (setq q (progn

2035 (forward-list 1)

2036 (setq r (point))

2037 (skip-chars-forward " \t")

2038 (if (and bbolp (eolp) (not (eobp)))

2039 (1+ (point))

2040 r))))

2041 t)

2042 (delete-region p q))

2043 (kill-region

2044 (if (bolp) (point) p)

2045 (progn (goto-char q)

2046 (forward-list 1)

2047 (setq r (point))

2048 (skip-chars-forward " \t")

2049 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2050 tag))))

2051

2052 (defun yahtml-kill-* (whole)

2053 "Kill current position's HTML tag (set)."

2054 (interactive "P")

2055 (cond

2056 ((yahtml-kill-begend whole))))

2057

2058

2059 ;;; ---------- changing ----------

2060 (defun yahtml-on-assignment-p ()

2061 "Return if current point is on parameter assignment.

2062 If so, return parameter name, otherwise nil.

2063 This function should be able to treat white spaces in value, but not yet."

2064 (let ((p (point)))

2065 (save-excursion

2066 (put 'yahtml-on-assignment-p 'region nil)

2067 (skip-chars-backward "^ \t\n")

2068 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2069 (< p (match-end 0))

2070 (>= p (1- (match-beginning 2)))

2071 (put 'yahtml-on-assignment-p 'region

2072 (cons (match-beginning 2) (match-end 2)))

2073 (YaTeX-match-string 1)))))

2074

2075 (defun yahtml-change-begend ()

2076 (let ((tag (yahtml-on-begend-p))

2077 (completion-ignore-case t)

2078 (case-fold-search t)

2079 (p (point)) (q (make-marker))

2080 (default (append yahtml-env-table yahtml-typeface-table))

2081 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2082 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2083 href b1 e1 attr new css)

2084 (cond

2085 (tag

2086 (cond

2087 ((and (string-match "^a$" tag)

2088 (save-excursion

2089 (and

2090 (re-search-backward "<a\\b" nil t)

2091 (progn

2092 (goto-char (match-end 0))

2093 (skip-chars-forward " \t\n")

2094 (setq b1 (point))

2095 (search-forward ">" nil t))

2096 (setq e1 (match-beginning 0))

2097 (goto-char b1)

2098 (re-search-forward "href\\s *=" e1 t)

2099 (>= p (point))

2100 (progn

2101 (goto-char (match-end 0))

2102 (skip-chars-forward " \t\n")

2103 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2104 (< p (match-end 0)))))

2105 (setq b1 (match-beginning 1) e1 (match-end 1)

2106 yahtml-completing-buffer (current-buffer)

2107 ;; yahtml-urls-local is buffer-local, so we must put

2108 ;; that into yahtml-urls here

2109 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2110 href (read-from-minibuffer

2111 "Change href to: " "" yahtml-url-completion-map))

2112 (if (string< "" href)

2113 (progn

2114 ;;(setq href ;??

2115 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2116 (delete-region b1 e1)

2117 (goto-char b1)

2118 (insert href))))

2119 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2120 (if (and (equal attr "class") ;treat "class" attribute specially

2121 (setq css (yahtml-css-get-element-completion-alist tag)))

2122

2123 (setq new (yahtml-read-css css))

2124 ;;other than "class", read parameter normally

2125 (setq new (yahtml-read-parameter attr)))

2126 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2127 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2128 (insert new))

2129 (t

2130 (save-excursion

2131 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2132 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2133 (skip-chars-forward "^A-Za-z")

2134 (set-marker q (point))

2135 (setq p (point))

2136 (yahtml-goto-corresponding-begend)

2137 (or (= (char-after (point)) ?<)

2138 (skip-chars-backward "^<"))

2139 (skip-chars-forward "^A-Za-z")

2140 (if (= (char-after (1- (point))) ?/)

2141 (progn

2142 (set-marker q (point))

2143 (goto-char p)))

2144 (setq tag (let ((completion-ignore-case t))

2145 (YaTeX-cplread-with-learning

2146 (format "Change `%s' to(default %s): "

2147 tag yahtml-last-begend)

2148 'default 'user 'tmp)))

2149 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2150 (if (string= "" tag) (setq tag yahtml-last-begend))

2151 (setq yahtml-last-begend

2152 (or (cdr (assoc tag yahtml-env-table)) tag)

2153 tag yahtml-last-begend)

2154 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2155 (insert (format "%s%s" tag (yahtml-addin tag)))

2156 (goto-char q)

2157 (set-marker q nil)

2158 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2159 (insert tag))))

2160 t))))

2161

2162 (defun yahtml-change-command ()

2163 (let ((p (point)) (case-fold-search t) cmd par new

2164 (beg (make-marker)) (end (make-marker)))

2165 (skip-chars-backward "^<")

2166 (if (and

2167 (looking-at yahtml-command-regexp)

2168 (progn

2169 (set-marker beg (match-beginning 0))

2170 (set-marker end (match-end 0))

2171 t) ;for further work

2172 (progn

2173 (forward-char -1)

2174 (condition-case nil

2175 (forward-list 1)

2176 (error nil))

2177 (< p (point))))

2178 (progn

2179 (goto-char p)

2180 (if (setq par (yahtml-on-assignment-p))

2181 (progn

2182 (setq new (yahtml-read-parameter par))

2183 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2184 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2185 (setq new

2186 (YaTeX-cplread-with-learning

2187 "Change form to: "

2188 'yahtml-form-table 'yahtml-user-form-table

2189 'yahtml-tmp-form-table)))

2190 (delete-region beg end)

2191 (goto-char beg)

2192 (set-marker beg nil)

2193 (set-marker end nil)

2194 (insert new)

2195 t)

2196 (goto-char p)

2197 nil)))

2198

2199 (defun yahtml-change-* ()

2200 "Change current position's HTML tag (set)."

2201 (interactive)

2202 (cond

2203 ((yahtml-change-begend))

2204 ((yahtml-change-command))))

2205

2206 ;;; ---------- commenting ----------

2207

2208 (defun yahtml-comment-region (&optional uncom)

2209 "Comment out region or environment."

2210 (interactive)

2211 (let ((e (make-marker)) be beg p)

2212 (cond

2213 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2214 (setq be (yahtml-on-begend-p))

2215 (save-excursion

2216 (setq p (point))

2217 (if (string-match "^/" be)

2218 (setq beg (progn (forward-line 1) (point)))

2219 (setq beg (progn (beginning-of-line) (point))))

2220 (goto-char p)

2221 (yahtml-goto-corresponding-begend)

2222 (if (string-match "^/" be)

2223 (beginning-of-line)

2224 (forward-line 1))

2225 (set-marker e (point))

2226 ;(comment-region beg (point) (if uncom (list 4)))))

2227 ))

2228 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2229 (setq beg (region-beginning))

2230 (set-marker e (region-end))))

2231 (if yahtml-translate-hyphens-when-comment-region

2232 (let ((yahtml-entity-reference-chars-alist-default nil)

2233 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2234 yahtml-entity-reference-chars-regexp

2235 yahtml-entity-reference-chars-reverse-regexp)

2236 (yahtml-entity-reference-chars-setup)

2237 (funcall

2238 (if uncom 'yahtml-translate-reverse-region

2239 'yahtml-translate-region)

2240 beg e)))

2241 (comment-region beg e (if uncom (list 4)))

2242 (set-marker e nil)))

2243

2244 (defun yahtml-uncomment-region ()

2245 (interactive)

2246 (yahtml-comment-region t))

2247

2248 ;;; ---------- translate to entity references ----------

2249 (defvar yahtml-entity-reference-chars-alist-default

2250 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2251 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2252 "Default translation table from character to entity reference")

2253 (defvar yahtml-entity-reference-chars-alist nil

2254 "*Translation table from character to entity reference")

2255 (defvar yahtml-entity-reference-chars-regexp nil)

2256 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2257

2258 (defun yahtml-entity-reference-chars-setup ()

2259 (let ((list (append yahtml-entity-reference-chars-alist-default

2260 yahtml-entity-reference-chars-alist)))

2261 (setq yahtml-entity-reference-chars-regexp "["

2262 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2263 (while list

2264 (setq yahtml-entity-reference-chars-regexp

2265 (concat yahtml-entity-reference-chars-regexp

2266 (char-to-string (car (car list))))

2267 yahtml-entity-reference-chars-reverse-regexp

2268 (concat yahtml-entity-reference-chars-reverse-regexp

2269 (cdr (car list))

2270 (if (cdr list) "\\|")))

2271 (setq list (cdr list)))

2272 (setq yahtml-entity-reference-chars-regexp

2273 (concat yahtml-entity-reference-chars-regexp "]")

2274 yahtml-entity-reference-chars-reverse-regexp

2275 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2276

2277 (yahtml-entity-reference-chars-setup)

2278

2279 (defun yahtml-translate-region (beg end)

2280 "Translate inhibited literals."

2281 (interactive "r")

2282 (save-excursion

2283 (save-restriction

2284 (narrow-to-region beg end)

2285 (let ((ct (append yahtml-entity-reference-chars-alist

2286 yahtml-entity-reference-chars-alist-default)))

2287 (goto-char beg)

2288 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2289 ;(setq c (preceding-char))

2290 (replace-match

2291 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2292

2293 (defun yahtml-translate-reverse-region (beg end)

2294 "Translate entity references to literals."

2295 (interactive "r")

2296 (save-excursion

2297 (save-restriction

2298 (narrow-to-region beg end)

2299 (let ((ct (append yahtml-entity-reference-chars-alist

2300 yahtml-entity-reference-chars-alist-default))

2301 ec)

2302 (goto-char beg)

2303 (while (re-search-forward

2304 yahtml-entity-reference-chars-reverse-regexp nil t)

2305 ;(setq c (preceding-char))

2306 (setq ec (YaTeX-match-string 1))

2307 (delete-region (match-end 0) (match-beginning 0))

2308 (insert (car (YaTeX-rassoc ec ct))))))))

2309

2310 (defun yahtml-inner-environment-but (exclude &optional quick)

2311 "Return the inner environment but matches with EXCLUDE tag."

2312 (let (e (case-fold-search t))

2313 (save-excursion

2314 (while (and (setq e (YaTeX-inner-environment quick))

2315 (string-match exclude e))

2316 (goto-char (get 'YaTeX-inner-environment 'point))))

2317 e))

2318

2319 (defun yahtml-untranslate-string (str)

2320 "Untranslate entity reference."

2321 (let ((md (match-data)) (left "") (right str) b0 ch

2322 (ct (append yahtml-entity-reference-chars-alist

2323 yahtml-entity-reference-chars-alist-default))

2324 (revrex yahtml-entity-reference-chars-reverse-regexp))

2325 (unwind-protect

2326 (progn

2327 (while (string< "" right)

2328 (cond

2329 ((string-match revrex right)

2330 (setq ch (YaTeX-rassoc

2331 (substring right (match-beginning 1) (match-end 1)))

2332 b0 (substring right 0 (match-beginning 0))

2333 right (substring right (match-end 0))

2334 left (concat left

2335 (substring right 0 (match-beginning 0))

2336 (char-to-string ch))))

2337 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2338 (setq ch (substring right (match-beginning 2) (match-end 2))

2339 b0 (substring right 0 (match-beginning 0))

2340 right (substring right (match-end 0))

2341 left (concat left

2342 b0

2343 (char-to-string

2344 (if (match-beginning 1)

2345 (YaTeX-hex ch)

2346 (string-to-number ch))))))

2347 (t (setq left (concat left right)

2348 right ""))))

2349 left)

2350 (store-match-data md))))

2351

2352 ;;; ---------- table-ize region ----------

2353 (defun yahtml-td-region (e delim beg end)

2354 "Enclose each item in a region with <td>..</td>.

2355 Interactive prefix argument consults enclosing element other than td."

2356 (interactive "P\nsDelimiter(s): \nr")

2357 (let ((e (cond

2358 ((null e) "td")

2359 ((stringp e) e)

2360 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2361 (ws "[ \t]")

2362 elm p i)

2363 (if (string= delim "") (setq delim " \t\n"))

2364 (setq delim (concat "[" delim "]+")

2365 elm (if (string= "thd" e)

2366 (cons "th" "td")

2367 (cons e e)))

2368 (save-excursion

2369 (save-restriction

2370 (narrow-to-region beg end)

2371 (goto-char (setq p (point-min)))

2372 (setq i 0 e (car elm))

2373 (while (re-search-forward delim nil t)

2374 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2375 (goto-char (match-beginning 0))

2376 (insert "</" e ">")

2377 (save-excursion

2378 (goto-char p)

2379 (insert "<" e ">"))

2380 (setq p (point))

2381 (while (and (not (eobp)) (looking-at ws))

2382 (delete-char 1))

2383 (if (looking-at delim) (delete-char 1)))

2384 (insert "<" e ">")

2385 (goto-char (point-max))

2386 (insert "</" e ">")))))

2387

2388 (defun yahtml-tr-region (e delim beg end)

2389 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2390 (interactive "P\nsDelimiter(s): \nr")

2391 (setq e (if (and e (listp e))

2392 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2393 "th")))

2394 (save-excursion

2395 (save-restriction

2396 (narrow-to-region (point) (mark))

2397 (goto-char (point-min))

2398 (while (not (eobp))

2399 (insert "<tr>")

2400 (yahtml-td-region e delim (point) (point-end-of-line))

2401 (end-of-line)

2402 (insert "</tr>")

2403 (forward-line 1)))))

2404

2405 ;;; ---------- filling ----------

2406 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2407 (defun yahtml-move-to-column (col &optional force)

2408 (beginning-of-line)

2409 (let ((ccol 0))

2410 (while (and (> col ccol) (not (eolp)))

2411 (if (eq (following-char) ?\<)

2412 (progn

2413 (while (and (not (eq (following-char) ?\>))

2414 (not (eolp)))

2415 (forward-char))

2416 (or (eolp) (forward-char)))

2417 (or (eolp) (forward-char))

2418 (if (eq (preceding-char) ?\t)

2419 (let ((wd (- 8 (% (+ ccol 8) 8))))

2420 (if (and force (< col (+ ccol wd)))

2421 (progn

2422 (backward-char 1)

2423 (insert-char ?\ (- col ccol))

2424 (setq ccol col))

2425 (setq ccol (+ ccol wd))))

2426 (setq ccol (1+ ccol)))

2427 (if (and YaTeX-japan

2428 (or

2429 (and (fboundp 'char-category)

2430 (string-match "[chj]" (char-category (preceding-char))))

2431 (and (fboundp 'char-charset)

2432 (not (eq (char-charset (preceding-char)) 'ascii)))))

2433 (setq ccol (1+ ccol)))))

2434 (if (and force (> col ccol))

2435 (progn

2436 (insert-char ?\ (- col ccol))

2437 col)

2438 ccol)))

2439

2440 (defun yahtml-fill-paragraph (arg)

2441 (interactive "P")

2442 (let*((case-fold-search t) (p (point)) fill-prefix

2443 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2444 indent

2445 (startp (get 'YaTeX-inner-environment 'point))

2446 (prep (string-match "^pre$" e))

2447 (ps1 (if prep (default-value 'paragraph-start)

2448 paragraph-start))

2449 (ps2 (if prep (concat (default-value 'paragraph-start)

2450 "$\\|^\\s *</?pre>")

2451 paragraph-start)))

2452 (save-excursion

2453 (unwind-protect

2454 (progn

2455 (if prep

2456 (fset 'move-to-column 'yahtml-move-to-column))

2457 (save-excursion

2458 (beginning-of-line)

2459 (indent-to-column (yahtml-this-indent))

2460 (setq fill-prefix

2461 (buffer-substring (point) (point-beginning-of-line)))

2462 (delete-region (point) (point-beginning-of-line)))

2463 (fill-region-as-paragraph

2464 (progn (re-search-backward paragraph-start nil t)

2465 (or (save-excursion

2466 (goto-char (match-beginning 0))

2467 (if (looking-at "<")

2468 (forward-list)

2469 (goto-char (match-end 0))

2470 (skip-chars-forward " \t>"))

2471 (if (looking-at "[ \t]*$")

2472 (progn (forward-line 1) (point))))

2473 (point)))

2474 (progn (goto-char p)

2475 (re-search-forward ps2 nil t)

2476 (match-beginning 0))))

2477 (fset 'move-to-column yahtml-saved-move-to-column)))))

2478

2479 ;(defun yahtml-indent-new-commnet-line ()

2480 ; (unwind-protect

2481 ; (progn

2482 ; (fset 'move-to-column 'yahtml-move-to-column)

2483 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2484 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2485

2486 ;;;

2487 ;;; ---------- indentation ----------

2488 ;;;

2489 (defun yahtml-indent-line ()

2490 "Indent a line (faster wrapper)"

2491 (interactive)

2492 (let (indent)

2493 (if (and (save-excursion

2494 (beginning-of-line) (skip-chars-forward "\t ")

2495 (not (looking-at "<")))

2496 (save-excursion

2497 (forward-line -1)

2498 (while (and (not (bobp)) (looking-at "^\\s *$"))

2499 (forward-line -1))

2500 (skip-chars-forward "\t ")

2501 (setq indent (current-column))

2502 (not (looking-at "<"))))

2503 (progn

2504 (save-excursion

2505 (beginning-of-line)

2506 (skip-chars-forward " \t")

2507 (or (= (current-column) indent)

2508 (YaTeX-reindent indent)))

2509 (and (bolp) (skip-chars-forward " \t")))

2510 (yahtml-indent-line-real))))

2511

2512 (defun yahtml-this-indent ()

2514 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2515 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2516 (excludes

2517 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2518 inenv p col peol (case-fold-search t))

2519 (save-excursion

2520 (beginning-of-line)

2521 (setq inenv (or (yahtml-inner-environment-but excludes t)

2522 "html")

2523 col (get 'YaTeX-inner-environment 'indent)

2524 p (get 'YaTeX-inner-environment 'point)

2525 op nil))

2526 (save-excursion

2527 (cond

2528 ((string-match (concat "^\$" envs "\$") inenv)

2529 (save-excursion

2530 (beginning-of-line)

2531 (skip-chars-forward " \t")

2532 (cond ;lookup current line's tag

2533 ((looking-at (concat "</\$" envs "\$>"))

2534 col)

2535 ((looking-at itms)

2536 (+ col yahtml-environment-indent))

2537 ((and yahtml-hate-too-deep-indentation

2538 (looking-at (concat "<\$" envs "\$")))

2539 (+ col (* 2 yahtml-environment-indent)))

2540 ((and (< p (point))

2541 (string-match itemizing-envs inenv)

2542 (save-excursion

2543 (and

2544 (setq op (point))

2545 (goto-char p)

2546 (re-search-forward itms op t)

2547 (progn

2548 (if yahtml-indent-listing-constant

2549 (setq col (+ (current-column)

2550 (if yahtml-faithful-to-htmllint 1 2)))

2551 (skip-chars-forward "^>")

2552 (skip-chars-forward ">")

2553 (skip-chars-forward " \t")

2554 (setq col (if (looking-at "$")

2555 (+ col yahtml-environment-indent)

2556 (current-column))))))))

2557 col)

2558 (t

2559 (+ col yahtml-environment-indent)))))

2560 (t col)))))

2561

2562 (defun yahtml-indent-line-real ()

2563 "Indent current line."

2564 (interactive)

2565 (YaTeX-reindent (yahtml-this-indent))

2566 (if (bolp) (skip-chars-forward " \t"))

2567 (let (peol col inenv)

2568 (if (and (setq inenv (yahtml-on-begend-p))

2569 (string-match

2570 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2571 (save-excursion

2572 (setq peol (point-end-of-line))

2573 (or (= (char-after (point)) ?<)

2574 (progn (skip-chars-backward "^<") (forward-char -1)))

2575 (setq col (current-column))

2576 (if (and (yahtml-goto-corresponding-begend t)

2577 (> (point) peol)) ;if on the different line

2578 (YaTeX-reindent col))))))

2579

2580 ;(defun yahtml-fill-item ()

2581 ; "Fill item HTML version"

2582 ; (interactive)

2583 ; (let (inenv p fill-prefix peol (case-fold-search t))

2584 ; (setq inenv (or (YaTeX-inner-environment) "html")

2585 ; p (get 'YaTeX-inner-environment 'point))

2586 ; (cond

2587 ; ((string-match "^[uod]l" inenv)

2588 ; (save-excursion

2589 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2590 ; (progn

2591 ; (goto-char (match-end 0))

2592 ; (setq col (current-column)))

2593 ; (error "No <li>, <dt>, <dd>")))

2594 ; (save-excursion

2595 ; (end-of-line)

2596 ; (setq peol (point))

2597 ; (newline)

2598 ; (indent-to-column col)

2599 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2600 ; (delete-region (point) peol)

2601 ; (fill-region-as-paragraph

2602 ; (progn (re-search-backward paragraph-start nil t) (point))

2603 ; (progn (re-search-forward paragraph-start nil t 2)

2604 ; (match-beginning 0)))))

2605 ; (t nil))))

2606

2607 ;;;

2608 ;;; ---------- Lint and Browsing ----------

2609 ;;;

2610 (defun yahtml-browse-menu ()

2611 "Browsing or other external process invokation menu."

2612 (interactive)

2613 (message "J)weblint p)Browse R)eload N)ewpage...")

2614 (let ((c (char-to-string (read-char))))

2615 (cond

2616 ((string-match "j" c)

2617 (yahtml-lint-buffer (current-buffer)))

2618 ((string-match "[bp]" c)

2619 (yahtml-browse-current-file))

2620 ((string-match "r" c)

2621 (yahtml-browse-reload))

2622 ((string-match "n" c)

2623 (call-interactively 'yahtml-newpage)))))

2624

2625 (if (fboundp 'wrap-function-to-control-ime)

2626 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2627

2628 (defvar yahtml-lint-buffer "*weblint*")

2629

2630 (defun yahtml-lint-buffer (buf)

2631 "Call lint on buffer BUF."

2632 (require 'yatexprc)

2633 (interactive "bCall lint on buffer: ")

2634 (setq buf (get-buffer buf))

2635 (YaTeX-save-buffers)

2636 (let ((bcmd (YaTeX-get-builtin "lint")))

2637 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2638 (YaTeX-typeset

2639 (concat (or bcmd yahtml-lint-program)

2640 " " (file-name-nondirectory (buffer-file-name buf)))

2641 yahtml-lint-buffer "lint" "lint")))

2642

2643 (defun yahtml-file-to-url (file)

2644 "Convert local unix file name to URL.

2645 If no matches found in yahtml-path-url-alist, return raw file name."

2646 (let ((list yahtml-path-url-alist) p url)

2647 (if (file-directory-p file)

2648 (setq file (expand-file-name yahtml-directory-index file))

2649 (setq file (expand-file-name file)))

2650 (if (string-match "^[A-Za-z]:/" file)

2651 (progn

2652 ;; (aset file 1 ?|) ;これは要らないらしい…

2653 (setq file (concat "///" file))))

2654 (while list

2655 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2656 (setq url (cdr (car list))

2657 file (substring file (match-end 0))

2658 url (concat url file)

2659 list nil))

2660 (setq list (cdr list)))

2661 (or url (concat "file:" file))))

2662

2663 (defun yahtml-url-to-path (file &optional basedir)

2664 "Convert local URL name to unix file name."

2665 (let ((list yahtml-path-url-alist) url realpath docroot

2666 (dirsufp (string-match "/$" file)))

2667 (setq basedir (or basedir

2668 (file-name-directory

2669 (expand-file-name default-directory))))

2670 (cond

2671 ((string-match "^/" file)

2672 (while list

2673 (if (file-directory-p (car (car list)))

2674 (progn

2675 (setq url (cdr (car list)))

2676 (if (string-match "\$http://[^/]*\$/" url)

2677 (setq docroot (substring url (match-end 1)))

2678 (setq docroot url))

2679 (cond

2680 ((string-match (concat "^" (regexp-quote docroot)) file)

2681 (setq realpath

2682 (expand-file-name

2683 (substring

2684 file

2685 (if (= (aref file (1- (match-end 0))) ?/)

2686 (match-end 0) ; "/foo"

2687 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2688 (car (car list))))))

2689 (if realpath

2690 (progn (setq list nil)

2691 (if (and dirsufp (not (string-match "/$" realpath)))

2692 (setq realpath (concat realpath "/")))))))

2693 (setq list (cdr list)))

2694 realpath)

2695 (t file))))

2696

2697 (defun yahtml-browse-current-file ()

2698 "Call WWW browser on current file."

2699 (interactive)

2700 (basic-save-buffer)

2701 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2702

2703 (defun yahtml-browse-reload ()

2704 "Send `reload' event to netscape."

2705 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2706 (cond

2707 ((string-match "[Nn]etscape" yahtml-www-browser)

2708 (if (get-buffer pb)

2709 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2710 ;;(or (get 'yahtml-netscape-sentinel 'url)

2711 ;; (error "Reload should be called after Browsing."))

2712 (put 'yahtml-netscape-sentinel 'url

2713 (yahtml-file-to-url (buffer-file-name)))

2714 (basic-save-buffer)

2715 (set-process-sentinel

2716 (setq yahtml-browser-process

2717 (start-process

2718 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2719 (format "%s -remote 'reload'" yahtml-www-browser)))

2720 'yahtml-netscape-sentinel))

2721 (t

2722 (message "Sorry, RELOAD is supported only for Netscape.")))))

2723

2724 ;;; ---------- Intelligent newline ----------

2725 (defun yahtml-intelligent-newline (arg)

2726 "Intelligent newline for HTML"

2727 (interactive "P")

2728 (let (env func)

2729 (end-of-line)

2730 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2731 "html")))

2732 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2733 (newline)

2734 (if (and env func (fboundp func))

2735 ;; if intelligent line function is defined, call that

2736 (funcall func)

2737 ;; else do the default action

2738 (if (string-match yahtml-p-prefered-env-regexp env)

2739 (yahtml-insert-p)))))

2740

2741 (defun yahtml-intelligent-newline-ul ()

2742 (interactive)

2743 (yahtml-insert-single "li")

2744 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2745 (yahtml-indent-line))

2746

2747 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2748

2749 (defun yahtml-intelligent-newline-dl ()

2750 (interactive)

2751 (let ((case-fold-search t))

2752 (if (save-excursion

2753 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2754 (get 'YaTeX-inner-environment 'point) t))

2755 (cond

2756 ((match-beginning 2)

2757 (yahtml-insert-single "dd")

2758 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2759 (setq yahtml-last-single-cmd "dt"))

2760 ((match-beginning 3)

2761 (yahtml-insert-single "dt")

2762 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2763 (setq yahtml-last-single-cmd "dd")))

2764 (yahtml-insert-single "dt")

2765 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2766 (setq yahtml-last-single-cmd "dd"))

2767 (yahtml-indent-line)

2768 (and (string-match yahtml-p-prefered-env-regexp "dl")

2769 (string-equal yahtml-last-single-cmd "dt")

2770 (yahtml-insert-p nil))))

2771

2772 (defun yahtml-intelligent-newline-select ()

2773 (interactive)

2774 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2775 (yahtml-indent-line))

2776

2777 (defun yahtml-intelligent-newline-style ()

2778 (interactive)

2779 (if (save-excursion

2780 (and

2781 (re-search-backward "<style\\|<!-- " nil t)

2782 (looking-at "<style")))

2783 (let (c)

2784 (yahtml-indent-line)

2785 (setq c (current-column))

2786 (insert "<!--\n")

2787 (YaTeX-reindent c)

2788 (insert "-->")

2789 (beginning-of-line)

2790 (open-line 1)

2791 (YaTeX-reindent c))))

2792

2793 (defun yahtml-intelligent-newline-head ()

2794 (let ((title (read-string "Document title: "))

2795 (b "<title>") (e "</title>") p)

2796 (yahtml-indent-line)

2797 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2798 (setq p (point))

2799 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2800 (if (string= "" title) (goto-char p))

2801 (setq yahtml-last-begend "body")))

2802

2803 (defun yahtml-intelligent-newline-script ()

2804 (let ((p (point)) b)

2805 (if (save-excursion

2806 (and

2807 (setq b (re-search-backward "<script\\>" nil t))

2808 (re-search-forward

2809 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2810 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2811 c (srcp (re-search-backward "src=" b t)))

2812 (goto-char p)

2813 (yahtml-indent-line)

2814 (setq c (current-column))

2815 (if srcp

2816 nil

2817 (insert "")

2818 (beginning-of-line)

2819 (open-line 1)

2820 (YaTeX-reindent c))))))

2821

2822 (defun yahtml-intelligent-newline-table ()

2823 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2824 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2825 (cond

2826 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2827 (while (and (setq rb (re-search-backward ptn tb t))

2828 (match-beginning 1))

2829 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2830 (goto-char (match-end 0))

2831 (skip-chars-forward " \t\n")

2832 (if (and (search-forward "colspan\\s *=" p t)

2833 (progn

2834 (skip-chars-forward "\"' \t\n")

2835 (looking-at "[0-9]+")))

2836 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2837 (setq cols (1+ cols)))

2838 (goto-char rb)

2839 (setq p (point)))

2840 (if (> cols 0)

2841 (message "%s columns found. %s"

2842 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2843 "New tr?(N) or Duplicate")))

2844 (cond

2845 ((and (> cols 0)

2846 (memq (read-char) '(?d ?D))) ;Duplication mode

2847 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2848 (t ;empty cells

2849 (setq line "<tr>" i 0)

2850 (if (> cols 0)

2851 (while (> cols i)

2852 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2853 "<td></td>"))

2854 th nil i (1+ i)))

2855 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2856 (while (string-match "t\$h\$\\|td" fmt i)

2857 (setq line (concat line (if (match-beginning 1) "<th></th>"

2858 "<td></td>"))

2859 i (match-end 0))))

2860 (setq line (concat line "</tr>"))))

2861 (goto-char cp)

2862 (if th

2863 (message

2864 "Type `%s' to change td from/to th."

2865 (key-description (car (where-is-internal 'yahtml-change-*)))))

2866 (if (string< "" line)

2867 (progn

2868 (insert line)

2869 (goto-char (+ 8 cp))

2870 (yahtml-indent-line)))))))

2871

2872 ;;; ---------- Marking ----------

2873 (defun yahtml-mark-begend ()

2874 "Mark current tag"

2875 (interactive)

2876 (YaTeX-beginning-of-environment)

2877 (let ((p (point)))

2878 (save-excursion

2879 (skip-chars-backward " \t" (point-beginning-of-line))

2880 (if (bolp) (setq p (point))))

2881 (push-mark p t))

2882 (yahtml-goto-corresponding-begend)

2883 (forward-list 1)

2884 (if (eolp) (forward-char 1)))

2885

2886 ;;; ---------- complete marks ----------

2887 (defun yahtml-complete-mark ()

2888 "Complete &gt, &lt, &ampersand, and &quote."

2889 (interactive)

2890 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2891 (let ((c (read-char)))

2892 (setq c (if (or (< c ?0) (> c ?7))

2893 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2894 (- c ?1)))

2895 (if (or (< c 0) (> c 6))

2896 nil

2897 (insert (format "&%s;"

2898 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2899

2900

2901 ;;; ---------- jump to error line ----------

2902 (defun yahtml-prev-error ()

2903 "Jump to previous error seeing lint buffer."

2904 (interactive)

2905 (or (get-buffer yahtml-lint-buffer)

2906 (error "No lint program ran."))

2907 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2908 (yahtml-jump-to-error-line t))

2909

2910 (defun yahtml-jump-to-error-line (&optional sit)

2911 (interactive "P")

2912 (let ((p (point)) (e (point-end-of-line)))

2913 (end-of-line)

2914 (if (re-search-backward yahtml-error-line-regexp nil t)

2915 (let ((f (if (string= "" (YaTeX-match-string 1))

2916 YaTeX-current-file-name

2917 (YaTeX-match-string 1)))

2918 (l (string-to-int (or (YaTeX-match-string 2)

2919 (YaTeX-match-string 3)))))

2920 (if sit (sit-for 1))

2921 (forward-line -1)

2922 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2923 (goto-line l))

2924 (message "No line number usage"))))

2925

2926 ;;; ---------- Style Sheet Support ----------

2927 (defvar yahtml-css-class-alist nil

2928 "Alist of elements vs. their classes")

2929

2930 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2931 (save-excursion

2932 (save-restriction

2933 (narrow-to-region beg end)

2934 (goto-char (point-min))

2935 (let ((alist initial) b e element class a)

2936 (setq b (point))

2937 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2938 (if (match-beginning 2)

2939 (let ((f (YaTeX-buffer-substring

2940 (progn (skip-chars-forward "^\"")(1+ (point)))

2941 (progn (forward-char 1)

2942 (skip-chars-forward "^\"")(point)))))

2943 (if (file-exists-p f)

2944 (setq alist

2945 (append alist (yahtml-css-collect-classes-file f)))))

2946 (setq e (point))

2947 (goto-char b)

2948 (while (re-search-forward ;ちょといい加減なREGEXP

2949 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2950 e t)

2951 (setq element (YaTeX-match-string 1)

2952 class (YaTeX-match-string 2))

2953 ;;if starts with period (match-string 1 is nil),

2954 ;;this is global class

2955 (setq element (downcase (or element "*")))

2956 (if (setq a (assoc element alist))

2957 (or (assoc class (cdr a))

2958 (setcdr a (cons (list class) (cdr a))))

2959 (setq alist (cons (list element (list class)) alist))))

2960 (goto-char (1- e))

2961 (search-forward "}" nil t)

2962 (setq b (point))))

2963 alist))))

2964

2965 (defun yahtml-css-collect-classes-buffer (&optional initial)

2966 (interactive)

2967 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2968

2969 (defun yahtml-css-collect-classes-file (file &optional initial)

2970 (let*((hilit-auto-highlight nil)

2971 (buf (get-buffer-create

2972 (format " *css-collection*%s" (file-name-nondirectory file))))

2973 (cb (current-buffer)))

2974 (unwind-protect

2975 (progn

2976 (set-buffer buf)

2977 (insert-file-contents file)

2978 (cd (or (file-name-directory file) "."))

2979 (yahtml-css-collect-classes-buffer initial))

2980 (if (eq buf cb)

2981 nil

2982 (kill-buffer buf)

2983 (set-buffer cb)))))

2984

2985 (defun yahtml-css-scan-styles ()

2986 (save-excursion

2987 (goto-char (point-min))

2988 (set (make-local-variable 'yahtml-css-class-alist) nil)

2989 (let (b tag type e href alist)

2990 (while (re-search-forward "<\$style\\|link\$" nil t)

2991 (setq b (match-beginning 0)

2992 tag (YaTeX-match-string 1))

2993 (cond

2994 ((string-match "style" tag)

2995 (goto-char b)

2996 (save-excursion (forward-list 1) (setq e (point)))

2997 (cond

2998 ((search-forward "text/css" e 1) ;css definition starts

2999 (setq alist

3000 (yahtml-css-collect-classes-region

3001 (point) (progn (search-forward "</style>") (point))

3002 alist)))))

3003 ((and (string-match "link" tag)

3004 (stringp (setq type (yahtml-get-attrvalue "type")))

3005 (string-match "text/css" type)

3006 (setq href (yahtml-get-attrvalue "href"))

3007 (file-exists-p (yahtml-url-to-path href)))

3008 (setq alist

3009 (yahtml-css-collect-classes-file

3010 (yahtml-url-to-path href) alist))))

3011 (setq yahtml-css-class-alist alist)))))

3012

3013 (defun yahtml-css-get-element-completion-alist (element)

3014 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3015 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3016 (and (or alist global)

3017 (append alist global))))

3018

3019 ;;; ---------- ----------

3020

3021 ;;;

3022 ;;hilit19

3023 ;;;

3024 (defvar yahtml-default-face-table

3025 '(

3026 (form black/ivory white/hex-442233 italic)

3027 ))

3028 (defvar yahtml-hilit-patterns-alist

3029 '(

3030 'case-fold

3031 ;; comments

3032 ("" comment)

3033 ;; include&exec

3034 ("" include)

3035 ;; string

3036 (hilit-string-find ?\\ string)

3037 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3038 ("</?[uod]l>" 0 decl)

3039 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3040 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3041 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3042 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3043 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3044 ))

3045

3046 (defun yahtml-hilit-region-tag (tag)

3047 "Return list of start/end point of <TAG> form."

3048 (if (re-search-forward tag nil t)

3049 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3050 (elm (YaTeX-match-string 1)))

3051 (skip-chars-forward "^>")

3052 (prog1

3053 (cons (1+ (point))

3054 (progn (re-search-forward (concat "</" elm ">") nil t)

3055 (match-beginning 0)))

3056 (goto-char e0)))))

3057

3058 (defun yahtml-hilit-region-tag-itself (ptn)

3059 "Return list of start/end point of <tag options...> itself."

3060 (if (re-search-forward ptn nil t)

3061 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3062 (skip-chars-forward "^<>")

3063 (if (eq (char-after (point)) ?<) nil

3064 (prog1

3065 (cons m0 (min (point-max) (1+ (point))))

3066 (goto-char e0))))))

3067

3068 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3069 (and yahtml-use-hilit19

3070 (or (assq 'yahtml-mode hilit-patterns-alist)

3071 (setq hilit-patterns-alist

3072 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3073 hilit-patterns-alist))))

3074 ;;;

3075 ;; for font-lock

3076 ;;;

3077

3078 ; <<STATIC KEYWORDS BELOW NOT USED>>

3079 ;(defvar yahtml-font-lock-keywords

3080 ; '(

3081 ; ;; comments

3082 ; ("" . font-lock-comment-face)

3083 ; ;; include&exec

3084 ; (""

3085 ; 0 font-lock-include-face keep)

3086 ; ;; string

3087 ; ;(hilit-string-find ?\\ string)

3088 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3089 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3090 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3091 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3092 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3093 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3094 ; )

3095 ; "*Defualt font-lock-keywords for yahtml-mode.")

3096 (defvar yahtml-font-lock-keywords

3097 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3098 "Default fontifying patterns for yahtml-mode")

3099

3100 (defun yahtml-font-lock-set-default-keywords ()

3101 (put 'yahtml-mode 'font-lock-defaults

3102 '(yahtml-font-lock-keywords nil t)))

3103

3104 (if yahtml-use-font-lock

3105 (progn

3106 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3107 ;;for those who use both hilit19 and font-lock

3108 (if (eq (car hilit-mode-enable-list) 'not)

3109 (or (member 'yahtml-mode hilit-mode-enable-list)

3110 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3111 (setq hilit-mode-enable-list

3112 (delq 'yahtml-mode hilit-mode-enable-list))))

3113 (yahtml-font-lock-set-default-keywords)))

3114

3115 (defun yahtml-font-lock-recenter (&optional arg)

3116 (interactive "P")

3117 (font-lock-mode -1) ;is stupid, but sure.

3118 (font-lock-mode 1))

3119

3120 (run-hooks 'yahtml-load-hook)

3121 (provide 'yahtml)

3122

3123 ; Local variables:

3124 ; fill-prefix: ";;; "

3125 ; paragraph-start: "^$\\|\\|;;;$"

3126 ; paragraph-separate: "^$\\|\\|;;;$"

3127 ; coding: sjis

3128 ; End: