yatex: e59126447ee7 yahtml.el

yatex

view yahtml.el @ 217:e59126447ee7

Recognize null environment name as \begin{} ... \end{}.

author	yuuji@gentei.org
date	Fri, 13 Jan 2012 16:19:56 +0900
parents	ee74177831b4
children	74229d191b17

line source

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

3 ;;; Last modified Thu Jan 12 11:40:53 2012 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.75"

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 yahtml-always-/li

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

255

256 (defvar yahtml-error-line-regexp

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

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

259

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

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

262 (defvar yahtml-escape-chars 'ask

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

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

265 at each reserved chars.")

266

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

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

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

270

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

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

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

274

275 (defvar yahtml-mode-abbrev-table nil

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

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

278

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

280 "*Boundary regexp for indentation calculation.")

281

282 (defvar yahtml-html4-strict t

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

284 Completing read for obsoleted attributes disabled.")

285

286 ;;; --- customizable variable ends here ---

287 (defvar yahtml-prefix-map nil)

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

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

290 (defvar yahtml-shell-command-option

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

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

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

294

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

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

297 (YaTeX-define-key

298 key

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

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

301 map))

302

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

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

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

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

307

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

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

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

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

312 (if YaTeX-inhibit-prefix-letter nil

313 (yahtml-define-begend-region-key

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

315

316 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

329 (let ((map yahtml-prefix-map))

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

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

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

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

334 (and YaTeX-emacs-19 window-system

335 (progn

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

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

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

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

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

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

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

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

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

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

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

347 (if YaTeX-no-begend-shortcut

348 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

387 (substitute-all-key-definition

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

389 (substitute-all-key-definition

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

391

392 (if yahtml-lint-buffer-map nil

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

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

395

396

397 (defvar yahtml-paragraph-start

398 (concat

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

400 "*Regexp of html paragraph separater")

401 (defvar yahtml-paragraph-separate

402 (concat

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

404 "*Regexp of html paragraph separater")

405 (defvar yahtml-syntax-table nil

406 "*Syntax table for yahtml-mode")

407

408 (if yahtml-syntax-table nil

409 (setq yahtml-syntax-table

410 (make-syntax-table (standard-syntax-table)))

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

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

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

414

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

416 "Regexp of constituent of html commands.")

417

418 ;;; Completion tables for `form'

419 (defvar yahtml-form-table

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

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

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

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

424

425 (defvar yahtml-env-table

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

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

428 ("OrderedList" . "ol")

429 ("UnorderedList" . "ul")

430 ("DefinitionList" . "dl")

431 ("Preformatted" . "pre")

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

433 ("address") ("button")

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

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

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

437 ))

438

439 (if yahtml-html4-strict

440 (setq yahtml-env-table

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

442

443 ;(defvar yahtml-itemizing-regexp

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

445 ; "Regexp of itemizing forms")

446

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

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

449

450 ;;; Completion tables for typeface designator

451 (and yahtml-always-/p

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

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

454 (and yahtml-always-/li

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

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

457 (and yahtml-always-/dt

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

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

460 (and yahtml-always-/dd

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

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

463

464 (defvar yahtml-typeface-table

465 (append

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

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

468 ("sup") ("sub") ("span") ("abbr"))

469 (if (not yahtml-html4-strict)

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

471 yahtml-env-table)

472 "Default completion table of typeface designator")

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

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

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

476

477 (defvar yahtml-single-cmd-table

478 '(("hr") ("br") ("option")

479 ("HorizontalRule" . "hr")

480 ("BreakLine" . "br")

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

482 ("!--#exec")

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

484 ("!--#include")

485 ;; ("Item" . "li")

486 ;; ("DefineTerm" . "dt")

487 ;; ("Description" . "dd")

488 ;; ("dd") ("dt") ("li")

489 )

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

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

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

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

494

495 (defvar yahtml-current-completion-type nil

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

497

498 (defvar yahtml-struct-name-regexp

499 (concat

500 "\\<\\("

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

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

503 "\\)\\b")

504 "Regexp of structure beginning.")

505

506 (defvar yahtml-closable-regexp

507 (concat

508 "\\<\\("

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

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

511 "\\)\\b")

512 "Regexp of any closable elemnts.")

513

514 (defvar yahtml-indent-listing-constant t

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

516 T for static indentation depth")

517

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

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

520

521

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

523 (cond

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

525 buffer-file-name)

526 (let ((dir default-directory)

527 charset af ext (ldir "")

528 line

529 (case-fold-search t)

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

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

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

533 (while (and dir

534 (not (string= dir ldir))

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

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

537 (if (file-exists-p af)

538 (save-excursion

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

540 (save-excursion

541 (goto-char (point-min))

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

543 (setq line (buffer-substring

544 (point-beginning-of-line)

545 (point-end-of-line))

546 dir nil)))

547 (kill-buffer (current-buffer))))

548 (if dir

549 (setq ldir dir

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

551 dir (file-name-directory dir))))

552 line))

553 (t nil)))

554

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

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

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

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

559 (case-fold-search t)

560 line

561 charset)

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

563 (progn

564 (string-match ptn line)

565 (setq charset

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

567 (cond

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

569 (setq charset 2))

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

571 (setq charset 3))

572 ((string-match "shift_jis" charset)

573 (setq charset 1))

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

575 (setq charset 4))

576 (t (setq charset nil)))

577 (setq dir "")))

578 (if (featurep 'mule)

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

580 charset))

581

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

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

584 x index-list)

585 ;;s/\\s *$//;

586 (if line

587 (progn

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

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

590 (while (string< "" line)

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

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

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

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

595 line "")))

596 (or (nreverse index-list)

597 (if (listp yahtml-directory-index)

598 yahtml-directory-index

599 (list yahtml-directory-index)))))))

600

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

602 (defun yahtml-mode ()

603 (interactive)

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

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

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

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

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

609 (cond

610 ((null coding) nil)

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

612 (setq buffer-file-coding-system

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

614 (save-excursion

615 (goto-char (point-min))

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

617 coding)))

618 ((featurep 'mule)

619 (set-file-coding-system coding))

620 ((boundp 'NEMACS)

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

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

623 (setq major-mode 'yahtml-mode

624 mode-name "yahtml"

625 YaTeX-current-file-name (file-name-nondirectory

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

627 local-abbrev-table yahtml-mode-abbrev-table)

628 (mapcar

629 (function (lambda (x)

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

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

632 (boundp (cdr x)))

633 (symbol-value (cdr x))

634 (cdr x)))))

635 '((YaTeX-ec . "")

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

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

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

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

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

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

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

643 (paragraph-start . yahtml-paragraph-start)

644 (paragraph-separate . yahtml-paragraph-separate)

645 (comment-start . "")

646 (comment-start-skip . comment-start)

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

648

649 (if yahtml-use-font-lock

650 (progn

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

652 (or (featurep 'xemacs)

653 (progn

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

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

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

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

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

659 (font-lock-fontify-buffer)))))

660 (set-syntax-table yahtml-syntax-table)

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

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

663 (yahtml-css-scan-styles)

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

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

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

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

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

669

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

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

672 font-lock-defaults)

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

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

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

676

677 (defun yahtml-version ()

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

679 (interactive)

680 (message

681 (concat "Yet Another HTML-mode "

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

683 " Revision "

684 yahtml-revision-number)))

685

686 (defun yahtml-quit ()

687 (interactive)

688 (and yahtml-mode-old-mode

689 (fboundp yahtml-mode-old-mode)

690 (funcall yahtml-mode-old-mode)))

691

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

693 (cond

694 ((featurep 'xemacs)

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

696 (set keymap nil)

697 (mapcar

698 (function

699 (lambda (bind)

700 (setq bind (cdr bind))

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

702 (setcar (cdr bind) 'progn))

703 (if (stringp (car (cdr bind)))

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

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

706 (symbol-value keymap))))))

707 bindlist)

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

709 (t

710 (mapcar

711 (function

712 (lambda (bind)

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

714 bindlist))))

715

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

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

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

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

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

721

722 ;;; Variables for mosaic url history

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

724 (defvar yahtml-urls-private nil)

725 (defvar yahtml-urls-local nil)

726

727 (cond

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

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

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

731 (YaTeX-define-menu

732 'yahtml-menu-map-sectioning

733 (nreverse

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

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

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

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

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

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

740 )))

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

742 (YaTeX-define-menu

743 'yahtml-menu-map-logical

744 (nreverse

745 '((em "Embolden" .

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

747 (dfn "Define a word" .

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

749 (cite "Citation" .

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

751 (code "Code" .

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

753 (kbd "Keyboard" .

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

755 (samp "Sample display" .

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

757 (strong "Strong" .

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

759 (VAR "Variable notation" .

760 (lambda () (interactive) (yahtml-insert-tag nil "var"))))))

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

762 (YaTeX-define-menu

763 'yahtml-menu-map-typeface

764 (nreverse

765 '((b "Bold" .

766 (lambda () (interactive) (yahtml-insert-tag nil "b")))

767 (i "Italic" .

768 (lambda () (interactive) (yahtml-insert-tag nil "i")))

769 (tt "Typewriter" .

770 (lambda () (interactive) (yahtml-insert-tag nil "tt")))

771 (u "Underlined" .

772 (lambda () (interactive) (yahtml-insert-tag nil "u"))))))

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

774 (YaTeX-define-menu

775 'yahtml-menu-map-listing

776 (nreverse

777 '((ul "Unordered" .

778 (lambda () (interactive) (yahtml-insert-begend nil "ul")))

779 (ol "Ordered" .

780 (lambda () (interactive) (yahtml-insert-begend nil "ol")))

781 (dl "Definition" .

782 (lambda () (interactive) (yahtml-insert-begend nil "dl"))))))

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

784 (YaTeX-define-menu

785 'yahtml-menu-map-item

786 (nreverse

787 '((li "Simple item" .

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

789 (dt "Define term" .

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

791 (dd "Description of term" .

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

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

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

795 (YaTeX-define-menu

796 'yahtml-menu-map

797 (nreverse

798 (list

799 (cons (list 'sect "Sectioning")

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

801 (cons (list 'list "Listing")

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

803 (cons (list 'item "Item")

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

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

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

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

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

809 (if (featurep 'xemacs)

810 (add-hook 'yahtml-mode-hook

811 '(lambda ()

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

813 (progn

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

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

816

817 ;;; ----------- Completion ----------

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

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

820 "Insert <cmd> ... </cmd>."

821 (interactive "P")

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

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

824 (cmd

825 (or env

826 (YaTeX-cplread-with-learning

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

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

829 (bolp (save-excursion

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

831 (cc (current-column)))

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

833 (setq yahtml-last-begend

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

835 yahtml-last-begend))

836 (setq cmd yahtml-last-begend)

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

838 (if region

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

840 ;; to enable continuous regioning by another environment

841 (let ((beg (region-beginning))

842 (end (region-end))

843 (addin (yahtml-addin cmd)))

844 (save-excursion

845 (goto-char end)

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

847 (goto-char beg)

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

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

850 (save-excursion

851 (insert "\n")

852 (indent-to-column cc)

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

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

855 (newline)

856 (yahtml-intelligent-newline nil))

857 (yahtml-indent-line))))

858

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

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

861 (interactive)

862 (yahtml-insert-begend t))

863

864

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

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

867 (interactive)

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

869 (or form

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

871 (setq form

872 (YaTeX-cplread-with-learning

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

874 'yahtml-form-table 'yahtml-user-form-table

875 'yahtml-tmp-form-table))))

876 (let ((p (point)) q)

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

878 (setq yahtml-last-form form)

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

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

881 ;;(indent-relative-maybe)

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

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

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

885

886 (defun yahtml-read-css (alist)

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

888 (minibuffer-completion-table alist))

889 (read-from-minibuffer

890 (substitute-command-keys

891 (if YaTeX-japan

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

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

894 nil YaTeX-minibuffer-completion-map nil)))

895

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

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

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

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

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

901 (defun yahtml-newpage (file ov)

902 "Create newpage via newpage script"

903 (interactive

904 (list

905 (let (insert-default-directory)

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

907 current-prefix-arg))

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

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

910 (insert (substring

911 (YaTeX-command-to-string

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

913 0 -1)))

914

915 ;;; ---------- Add-in ----------

916 (defun yahtml-addin (form)

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

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

919 (concat

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

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

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

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

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

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

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

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

928 (string< "" s))

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

930 ""))))

931

932 (defvar yahtml-completing-buffer nil)

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

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

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

936 (let (list end)

937 (save-excursion

938 (set-buffer yahtml-completing-buffer)

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

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

941 (save-excursion

942 (goto-char (point-min))

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

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

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

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

947 (setq end (match-end 0))

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

949 (yahtml-on-assignment-p)

950 (progn

951 (goto-char end)

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

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

954 (setq list (cons

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

956 list))))

957 list))))

958

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

960 (if yahtml-url-completion-map nil

961 (setq yahtml-url-completion-map

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

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

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

965

966 (defun yahtml-complete-url ()

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

968 (interactive)

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

970 (lim (YaTeX-minibuffer-begin))

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

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

973 (cond

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

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

976 listfunc (list 'lambda nil

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

978 beg min))

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

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

981 (progn

982 (setq path (substring initial 0 beg))

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

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

985 (setq initial (substring initial beg))

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

987 cmpl (try-completion initial labels)

988 listfunc (list 'lambda ()

989 (list 'all-completions

990 initial (list 'quote labels)))

991 beg (+ min beg)))

992 (t

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

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

995 initial))

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

997 file (file-name-nondirectory path)

998 initial file

999 cmpl (file-name-completion file dir)

1000 listfunc (list 'lambda nil

1001 (list 'file-name-all-completions

1002 file dir))

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

1004 (cond

1005 ((stringp cmpl)

1006 (if (string= initial cmpl)

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

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

1009 (princ

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

1011 (delete-region (point) beg)

1012 (insert cmpl)))

1013 ((null cmpl)

1014 (ding))

1015 ((eq t cmpl)

1016 (save-excursion

1017 (unwind-protect

1018 (progn

1019 (goto-char p)

1020 (insert " [Sole completion]"))

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

1022

1023 ;

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

1025 ; From: Masayasu Ishikawa <mimasa<at>sfc.keio.ac.jp>

1026 ; To: yatex<at>arcadia.jaist.ac.jp

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

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

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

1030 ;

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

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

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

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

1035 (defvar yahtml-unsafe-chars-regexp

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

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

1038 ;

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

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

1041 ;

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

1043 ; "$" | ","

1044 (defvar yahtml-unreserved-chars-regexp

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

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

1047 Not used yet.")

1048

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

1050 "Translate reserved chars to URL encoded string."

1051 (let ((p 0) (target "")

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

1053 (cond

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

1055 (t

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

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

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

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

1060 (setq target (concat target

1061 (substring str 0 p)

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

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

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

1065 (concat target str)))))

1066

1067 (defun yahtml-unescape-string (str)

1068 "Untranslate reserved URL-encoded string."

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

1070 (unwind-protect

1071 (progn

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

1073 (setq target (concat target

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

1075 p (match-end 0)

1076 c (YaTeX-hex (substring

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

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

1079 (concat target (substring str p)))

1080 (store-match-data md))))

1081

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

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

1084 (interactive "r")

1085 (save-excursion

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

1087 (goto-char beg)

1088 (while (and (< (point) e)

1089 (re-search-forward

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

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

1092 (sit-for 0)

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

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

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

1096 ; (unwind-protect

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

1098 ; (save-excursion

1099 ; (backward-char 1)

1100 ; (delete-backward-char 4))

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

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

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

1104 (progn

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

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

1107 (set-marker e nil))))

1108 ;; ab%defgls/.|

1109

1110 (defun yahtml:a ()

1111 "Add-in function for <a>"

1112 (let ((href ""))

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

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

1115 href (yahtml-escape-chars-string

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

1117 (prog1

1118 (concat (yahtml-make-optional-argument

1119 "href" href)

1120 (yahtml-make-optional-argument

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

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

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

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

1125 (YaTeX-update-table

1126 (list href)

1127 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1128

1129 (defvar yahtml-parameters-completion-alist

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

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

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

1133 ("src" . file) ("file" . file)

1134 ("background" . file)

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

1136 ("method" ("POST") ("GET"))

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

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

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

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

1141 ("http-equiv" ("Refresh"))))

1142

1143 (defvar yahtml-link-types-alist

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

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

1146 ("subsection") ("appendix") ("help") ("bookmark")))

1147

1148 (defvar yahtml-content-types-alist

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

1150 ("text/sgml") ("text/xml")

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

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

1153 ("application/java")

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

1155 "Alist of content-types")

1156

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

1158 (let* ((alist

1159 (cdr-safe (assoc (downcase par)

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

1161 (prompt (concat par ": "))

1162 v)

1163 (cond

1164 ((eq alist 'file)

1165 (let ((insert-default-directory))

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

1167 ((eq alist 'command)

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

1169 (read-shell-command prompt)

1170 (read-string prompt)))

1171 ((and alist (symbolp alist))

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

1173 (alist

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

1175 (t

1176 (read-string prompt default)))))

1177

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

1179 "Make optional argument string."

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

1181 ""

1182 (concat " "

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

1184 "=\"" arg "\"")))

1185

1186 (defun yahtml:html ()

1187 "Add-in for <html>"

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

1189 (yahtml-make-optional-argument

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

1191

1192 (defun yahtml:head ()

1193 "Add-in for <head>"

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

1195 "")

1196

1197 (defun yahtml:body ()

1198 "Add-in function for <body>"

1199 (cond

1200 (yahtml-html4-strict nil)

1201 (t

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

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

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

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

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

1207 (concat

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

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

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

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

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

1213

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

1215 "Make CSS property definitions in style attribute."

1216 (mapconcat

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

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

1219 (delq nil proplist)

1220 " "))

1221

1222 (defun yahtml:img ()

1223 "Add-in function for <img>"

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

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

1226 alt

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

1228 (l yahtml-prefer-upcase-attributes)

1229 info width height bytes comments)

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

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

1232 (car info)

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

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

1235 bytes (car (cdr (cdr info)))

1236 comments (nth 4 info)))

1237 (if info

1238 (setq alt

1239 (YaTeX-replace-formats

1240 yahtml:img-default-alt-format

1241 (list (cons "x" width)

1242 (cons "y" height)

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

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

1245 (cons "c" (car comments))))))

1246

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

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

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

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

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

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

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

1254 (if yahtml-html4-strict

1255 (yahtml-make-optional-argument

1256 "style"

1257 (if (or brd alg)

1258 (yahtml-make-style-parameter

1259 (list

1260 (if (string< "" alg)

1261 (cons "align" alg))

1262 (if (string< "" brd)

1263 (cons "border"

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

1265 (concat

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

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

1268

1269 (defun yahtml-file-truename (file)

1270 (cond

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

1272 (t (let ((new file))

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

1274 (not (equal new file)))

1275 (setq file new))

1276 file))))

1277

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

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

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

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

1282 (let ((mlt 1)

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

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

1285 (value 0))

1286 (while (> length 0)

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

1288 pos (+ pos direc)

1289 mlt (* mlt 256)

1290 length (1- length)))

1291 value))

1292

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

1294 "Return the information on the image file FILE.

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

1296 (save-excursion

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

1298 width height bytes depth comment

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

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

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

1302 (seekpoint 1)

1303 c1 c2 c3 c4 beg end

1304 (case-fold-search nil))

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

1306 (set-buffer tmpbuf)

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

1308 (erase-buffer)

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

1310 (unwind-protect

1311 (progn

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

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

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

1315 (YaTeX-insert-file-contents

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

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

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

1319 c2 (char-after 2)

1320 c3 (char-after 3)

1321 c4 (char-after 4))

1322 (cond

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

1324 ;;JPEG images need JPEG markers inspection

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

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

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

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

1329 (catch 'exit

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

1331 (cond

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

1333 ;maybe corrupted, exit from loop

1334 (throw 'exit t))

1335 ((memq

1336 (char-after (1+ seekpoint))

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

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

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

1340 ;;found!

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

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

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

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

1345 ;; JPEG comment area

1346 (setq beg (+ seekpoint 2 2)

1347 end (+ seekpoint

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

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

1350 (t ;other markers

1351 nil)) ;just skip it

1352 (setq seekpoint (+ seekpoint 2)

1353 seekpoint (+ seekpoint

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

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

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

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

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

1359 height (yahtml-hex-value 20 4)

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

1361 ((looking-at "GIF8")

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

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

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

1365 ((looking-at "BM")

1366 ;;# OS/2, Windoze BMP files

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

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

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

1370 (cond

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

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

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

1374 (t

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

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

1377 (message "")

1378 (kill-buffer tmpbuf))

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

1380

1381 (defun yahtml:form ()

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

1383 (concat

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

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

1386 "\""

1387 (yahtml-make-optional-argument

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

1389 (completing-read

1390 "Enctype: "

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

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

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

1394

1395 (defun yahtml:select ()

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

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

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

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

1400

1401 (defun yahtml:ol ()

1402 "Add-in function for <ol>"

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

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

1405 (type (completing-read

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

1407 (concat

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

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

1410 (defun yahtml:ul ()

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

1412 (defun yahtml:dl ()

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

1414 (defun yahtml:dt ()

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

1416

1417 (defun yahtml:p ()

1418 (if yahtml-html4-strict nil

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

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

1421

1422 (defvar yahtml-input-types

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

1424 ("reset") ("image") ("hidden") ("file")))

1425

1426 (defun yahtml:input ()

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

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

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

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

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

1432 yahtml-input-types nil t)

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

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

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

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

1437 (concat

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

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

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

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

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

1443

1444 (defun yahtml:textarea ()

1445 "Add-in function for `textarea'"

1446 (interactive)

1447 (let (name rows cols)

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

1449 cols (read-string "Columns: ")

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

1451 (concat

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

1453 "\"" name "\"")

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

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

1456

1457 (defun yahtml:table ()

1458 "Add-in function for `table'"

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

1460 (a (yahtml-read-parameter

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

1462 (if yahtml-html4-strict

1463 (yahtml-make-optional-argument

1464 "style"

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

1466 (yahtml-make-style-parameter

1467 (append

1468 (if (string< "" b)

1469 (list

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

1471 (cons "border-collapse" "collapse")))

1472 (if (string< "" a)

1473 (cond

1474 ((string-match "right" a)

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

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

1477 ((string-match "center" a)

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

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

1480 (concat

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

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

1483

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

1485 (defun yahtml:caption ()

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

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

1488 (if yahtml-html4-strict

1489 (yahtml-make-optional-argument

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

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

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

1493

1494 (defun yahtml:font ()

1495 "Add-in function for `font'"

1496 (concat

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

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

1499

1500 (defun yahtml:style ()

1501 "Add-in function for `style'"

1502 (yahtml-make-optional-argument

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

1504

1505 (defun yahtml:script ()

1506 "Add-in function for `script'"

1507 (concat

1508 (yahtml-make-optional-argument

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

1510 (yahtml-make-optional-argument

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

1512

1513 (defun yahtml:tr ()

1514 "Add-in function for `tr'"

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

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

1517 "")

1518

1519 (defun yahtml:link ()

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

1521 (let (rel rev type href)

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

1523 (cond

1524 ((equal rel "")

1525 (concat (yahtml-make-optional-argument

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

1527 (yahtml-make-optional-argument

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

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

1530 )))

1531 ((string-match "stylesheet" rel)

1532 (concat

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

1534 (yahtml-make-optional-argument

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

1536 (progn

1537 (setq href

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

1539 (if (string< "" href)

1540 (progn

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

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

1543 (setq yahtml-css-class-alist

1544 (yahtml-css-collect-classes-file

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

1546 (message "")

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

1548 (t

1549 (concat

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

1551 (yahtml-make-optional-argument

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

1553 (yahtml-make-optional-argument

1554 "href"

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

1556

1557 (defvar yahtml:meta-names

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

1559

1560 (defun yahtml:meta ()

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

1562 "name"

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

1564 http-equiv content)

1565 (if (string= "" name)

1566 (if (string-match

1567 "Content-type"

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

1569 "http-equiv"

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

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

1572 "See docs/qanda")

1573 (concat http-equiv

1574 (yahtml-make-optional-argument

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

1576 (concat

1577 name

1578 (yahtml-make-optional-argument

1579 "content"

1580 (cond

1581 ((string-match "date" name)

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

1583 ((string-match "author" name)

1584 (read-string "Author: "

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

1586 (user-full-name)

1587 (user-login-name))))

1588 ((string-match "GENERATOR" name)

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

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

1591 (message "Thank you!"))

1592 content)

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

1594

1595 (defun yahtml:br ()

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

1597

1598 (defun yahtml:object ()

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

1600 data classid)

1601 (cond

1602 ((string-match "java" codetype)

1603 (let ((completion-ignored-extensions

1604 ;;any extensions except ".class"

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

1606 (setq classid (concat "java:"

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

1608 (concat

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

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

1611 (yahtml-make-optional-argument

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

1613 (yahtml-make-optional-argument

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

1615 (yahtml-make-optional-argument

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

1617 (t

1618 ""))))

1619

1620 (defun yahtml:abbr ()

1621 "Add-in function for abbr."

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

1623

1624 (defun yahtml:button ()

1625 (concat

1626 (yahtml-make-optional-argument

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

1628 (yahtml-make-optional-argument

1629 "type" (yahtml-read-parameter

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

1631 (yahtml-make-optional-argument

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

1633

1634 ;;; ---------- Simple tag ----------

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

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

1637 (interactive "P")

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

1639 (or tag

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

1641 (setq tag

1642 (YaTeX-cplread-with-learning

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

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

1645 'yahtml-typeface-table 'yahtml-user-typeface-table

1646 'yahtml-tmp-typeface-table))))

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

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

1649 (setq yahtml-last-typeface-cmd tag

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

1651 (if region-mode

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

1653 (save-excursion

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

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

1656 (exchange-point-and-mark)

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

1658 (message "No mark set now"))

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

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

1661

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

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

1664 (interactive)

1665 (yahtml-insert-tag t tag))

1666

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

1668 (defun yahtml-insert-single (cmd)

1669 "Insert <CMD>."

1670 (interactive

1671 (list

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

1673 (YaTeX-cplread-with-learning

1674 (format "Command%s: "

1675 (if yahtml-last-single-cmd

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

1677 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1680 (setq yahtml-last-single-cmd

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

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

1683 yahtml-last-single-cmd))

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

1685 cmd

1686 (yahtml-addin cmd)

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

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

1689 " /" "")))

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

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

1692

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

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

1695 (interactive "P")

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

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

1698

1699 (defun yahtml-insert-amps (arg)

1700 "Insert char-entity references via ampersand"

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

1702 (interactive "P")

1703 (let*((mess "") c

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

1705 yahtml-entity-reference-chars-alist))

1706 (l list))

1707 (while l

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

1709 l (cdr l)))

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

1711 (setq c (read-char))

1712 (cond

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

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

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

1716 (insert "&;")

1717 (forward-char -1))

1718 ((equal c ? )

1719 (insert ?&))

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

1721

1722 (defun yahtml:!--\#include ()

1723 (let ((file (yahtml-read-parameter "file" "")))

1724 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1725

1726 (defun yahtml:!--\#exec ()

1727 (format "cmd=\"%s\"--"

1728 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))

1729

1730 ;;; ---------- Jump ----------

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

1732 "Check if point is on href clause."

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

1734 (save-excursion

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

1736 (save-excursion

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

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

1739 (setq e (point)))

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

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

1742 (search-forward "href" e t)

1743 (search-forward "=" e t)

1744 (progn

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

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

1747 (< p (match-end 0))

1748 (yahtml-unescape-string (YaTeX-match-string 1))))))

1749

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

1751 (cond

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

1753 (set-process-buffer proc nil))

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

1755 (let ((cb (current-buffer)))

1756 (set-buffer (process-buffer proc))

1757 (goto-char (point-min))

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

1759 (progn

1760 (message "Starting netscape...")

1761 (start-process

1762 "browser" (process-buffer proc)

1763 shell-file-name yahtml-shell-command-option

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

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

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

1767 (set-buffer cb)))))

1768

1769 (defvar yahtml-browser-process nil)

1770

1771 (defun yahtml-browse-html (href)

1772 "Call WWW Browser to see HREF."

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

1774 (cond

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

1776 (if (get-buffer pb)

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

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

1779 (set-process-sentinel

1780 (setq yahtml-browser-process

1781 (start-process

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

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

1784 'yahtml-netscape-sentinel))

1785 ((and (string-match

1786 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

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

1788 (if (get-buffer pb)

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

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

1791 (set-process-sentinel

1792 (setq yahtml-browser-process

1793 (start-process

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

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

1796 'yahtml-netscape-sentinel))

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

1798 (w3-fetch href))

1799 ((stringp yahtml-www-browser)

1800 (if (and yahtml-browser-process

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

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

1803 (setq yahtml-browser-process

1804 (start-process

1805 "browser" "* WWW Browser *"

1806 shell-file-name yahtml-shell-command-option

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

1808 (t

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

1810

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

1812 "Go to corresponding name."

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

1814 (if href

1815 (cond

1816 ((string-match "^\$ht\\|f\$tps?:" href)

1817 (yahtml-browse-html href))

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

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

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

1821 (if (string< "" file)

1822 (progn

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

1824 (or (catch 'dirindex

1825 (mapcar

1826 (function

1827 (lambda (f)

1828 (if (file-exists-p (concat file f))

1829 (throw 'dirindex

1830 (setq file (concat file f))))))

1831 (yahtml-get-directory-index))

1832 nil)

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

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

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

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

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

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

1839 (if name

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

1841 t)))))

1842

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

1844 "Jump to html's named tag."

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

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

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

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

1849

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

1851 "Check if point is on begend clause."

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

1853 (save-excursion

1854 (goto-char p)

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

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

1857 (looking-at

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

1859 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1860 (condition-case nil

1861 (forward-list 1)

1862 (error nil))

1863 (< p (point)))

1864 (YaTeX-match-string 1)))))

1865

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

1867 "Go to corresponding opening/closing tag.

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

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

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

1871 (cond

1872 (cmd

1873 (setq m0 (match-beginning 0))

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

1875 (setq cmd (substring cmd 1)

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

1877 func 're-search-backward)

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

1879 func 're-search-forward))

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

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

1882 nil

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

1884 (if (< nest 0)

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

1886 (funcall

1887 (if noerr 'message 'error)

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

1889 (goto-char p)

1890 nil))

1891 (t nil))))

1892

1893 (defun yahtml-current-tag ()

1894 "Return the current tag name including #exec and #include."

1895 (save-excursion

1896 (let ((p (point)) b tag)

1897 (or (bobp)

1898 (looking-at "<")

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

1900 (setq b (point))

1901 (skip-chars-forward "<")

1902 (setq tag (YaTeX-buffer-substring

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

1904 (goto-char b)

1905 (forward-list 1)

1906 (and (< p (point)) tag))))

1907

1908 (defun yahtml-get-attrvalue (attr)

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

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

1911 (save-excursion

1912 (or (looking-at "<")

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

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

1915 (if (and

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

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

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

1919 (YaTeX-match-string 1)))))

1920

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

1922 "View image on point"

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

1924 (if (and tag

1925 (string-match "img" tag)

1926 (setq image

1927 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1928 (progn

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

1930 (start-process

1931 "Viewer" " * Image Viewer *"

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

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

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

1935

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

1937 "Goto applet's or script's source."

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

1939 (cond

1940 ((string-match "applet" env)

1941 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1942 (progn

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

1944 s (concat

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

1946 ".java"))

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

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

1949 s) ;return source file name

1950 (message "No applet source specified")

1951 (sit-for 1)

1952 nil))

1953 ((string-match "script" env)

1954 (if (setq s (yahtml-get-attrvalue "src"))

1955 (progn

1956 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1957 'YaTeX-switch-to-buffer)

1958 (yahtml-url-to-path s))

1959 s)))

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

1961 (cond

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

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

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

1965 s)

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

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

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

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

1970 s)))

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

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

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

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

1975 (unwind-protect

1976 (progn

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

1978 (YaTeX-insert-file-contents s nil 0 100)

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

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

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

1982 (kill-buffer (get-buffer b)))

1983 (get-file-buffer s))))))

1984

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

1986 "Go to corresponding object."

1987 (interactive "P")

1988 (cond

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

1990 ((yahtml-goto-corresponding-img))

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

1992 ((yahtml-goto-corresponding-begend))

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

1994

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

1996 "Go to corresponding object."

1997 (interactive)

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

1999

2000 (defun yahtml-visit-main ()

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

2002 (interactive)

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

2004

2005 ;;; ---------- killing ----------

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

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

2008 (if tag

2009 (save-excursion

2010 (or (looking-at "<")

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

2012 (setq p (point))

2013 (yahtml-goto-corresponding-begend)

2014 (or (looking-at "<")

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

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

2017 (progn (setq q p p (point))

2018 (goto-char q))

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

2020 (if (not whole)

2021 (kill-region

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

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

2024 (progn (forward-list 1)

2025 (setq r (point))

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

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

2028 (goto-char p)

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

2030 (if (not whole)

2031 (progn

2032 (kill-append

2033 (buffer-substring

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

2035 (setq q (progn

2036 (forward-list 1)

2037 (setq r (point))

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

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

2040 (1+ (point))

2041 r))))

2042 t)

2043 (delete-region p q))

2044 (kill-region

2045 (if (bolp) (point) p)

2046 (progn (goto-char q)

2047 (forward-list 1)

2048 (setq r (point))

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

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

2051 tag))))

2052

2053 (defun yahtml-kill-* (whole)

2054 "Kill current position's HTML tag (set)."

2055 (interactive "P")

2056 (cond

2057 ((yahtml-kill-begend whole))))

2058

2059

2060 ;;; ---------- changing ----------

2061 (defun yahtml-on-assignment-p ()

2062 "Return if current point is on parameter assignment.

2063 If so, return parameter name, otherwise nil.

2064 This function should be able to treat white spaces in value, but not yet."

2065 (let ((p (point)))

2066 (save-excursion

2067 (put 'yahtml-on-assignment-p 'region nil)

2068 (skip-chars-backward "^ \t\n")

2069 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2070 (< p (match-end 0))

2071 (>= p (1- (match-beginning 2)))

2072 (put 'yahtml-on-assignment-p 'region

2073 (cons (match-beginning 2) (match-end 2)))

2074 (YaTeX-match-string 1)))))

2075

2076 (defun yahtml-change-begend ()

2077 (let ((tag (yahtml-on-begend-p))

2078 (completion-ignore-case t)

2079 (case-fold-search t)

2080 (p (point)) (q (make-marker))

2081 (default (append yahtml-env-table yahtml-typeface-table))

2082 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2083 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2084 href b1 e1 attr new css)

2085 (cond

2086 (tag

2087 (cond

2088 ((and (string-match "^a$" tag)

2089 (save-excursion

2090 (and

2091 (re-search-backward "<a\\b" nil t)

2092 (progn

2093 (goto-char (match-end 0))

2094 (skip-chars-forward " \t\n")

2095 (setq b1 (point))

2096 (search-forward ">" nil t))

2097 (setq e1 (match-beginning 0))

2098 (goto-char b1)

2099 (re-search-forward "href\\s *=" e1 t)

2100 (>= p (point))

2101 (progn

2102 (goto-char (match-end 0))

2103 (skip-chars-forward " \t\n")

2104 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2105 (< p (match-end 0)))))

2106 (setq b1 (match-beginning 1) e1 (match-end 1)

2107 yahtml-completing-buffer (current-buffer)

2108 ;; yahtml-urls-local is buffer-local, so we must put

2109 ;; that into yahtml-urls here

2110 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2111 href (read-from-minibuffer

2112 "Change href to: " "" yahtml-url-completion-map))

2113 (if (string< "" href)

2114 (progn

2115 ;;(setq href ;??

2116 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2117 (delete-region b1 e1)

2118 (goto-char b1)

2119 (insert href))))

2120 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2121 (if (and (equal attr "class") ;treat "class" attribute specially

2122 (setq css (yahtml-css-get-element-completion-alist tag)))

2123

2124 (setq new (yahtml-read-css css))

2125 ;;other than "class", read parameter normally

2126 (setq new (yahtml-read-parameter attr)))

2127 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2128 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2129 (insert new))

2130 (t

2131 (save-excursion

2132 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2133 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2134 (skip-chars-forward "^A-Za-z")

2135 (set-marker q (point))

2136 (setq p (point))

2137 (yahtml-goto-corresponding-begend)

2138 (or (= (char-after (point)) ?<)

2139 (skip-chars-backward "^<"))

2140 (skip-chars-forward "^A-Za-z")

2141 (if (= (char-after (1- (point))) ?/)

2142 (progn

2143 (set-marker q (point))

2144 (goto-char p)))

2145 (setq tag (let ((completion-ignore-case t))

2146 (YaTeX-cplread-with-learning

2147 (format "Change `%s' to(default %s): "

2148 tag yahtml-last-begend)

2149 'default 'user 'tmp)))

2150 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2151 (if (string= "" tag) (setq tag yahtml-last-begend))

2152 (setq yahtml-last-begend

2153 (or (cdr (assoc tag yahtml-env-table)) tag)

2154 tag yahtml-last-begend)

2155 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2156 (insert (format "%s%s" tag (yahtml-addin tag)))

2157 (goto-char q)

2158 (set-marker q nil)

2159 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2160 (insert tag))))

2161 t))))

2162

2163 (defun yahtml-change-command ()

2164 (let ((p (point)) (case-fold-search t) cmd par new

2165 (beg (make-marker)) (end (make-marker)))

2166 (skip-chars-backward "^<")

2167 (if (and

2168 (looking-at yahtml-command-regexp)

2169 (progn

2170 (set-marker beg (match-beginning 0))

2171 (set-marker end (match-end 0))

2172 t) ;for further work

2173 (progn

2174 (forward-char -1)

2175 (condition-case nil

2176 (forward-list 1)

2177 (error nil))

2178 (< p (point))))

2179 (progn

2180 (goto-char p)

2181 (if (setq par (yahtml-on-assignment-p))

2182 (progn

2183 (setq new (yahtml-read-parameter par))

2184 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2185 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2186 (setq new

2187 (YaTeX-cplread-with-learning

2188 "Change form to: "

2189 'yahtml-form-table 'yahtml-user-form-table

2190 'yahtml-tmp-form-table)))

2191 (delete-region beg end)

2192 (goto-char beg)

2193 (set-marker beg nil)

2194 (set-marker end nil)

2195 (insert new)

2196 t)

2197 (goto-char p)

2198 nil)))

2199

2200 (defun yahtml-change-* ()

2201 "Change current position's HTML tag (set)."

2202 (interactive)

2203 (cond

2204 ((yahtml-change-begend))

2205 ((yahtml-change-command))))

2206

2207 ;;; ---------- commenting ----------

2208

2209 (defun yahtml-comment-region (&optional uncom)

2210 "Comment out region or environment."

2211 (interactive)

2212 (let ((e (make-marker)) be beg p)

2213 (cond

2214 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2215 (setq be (yahtml-on-begend-p))

2216 (save-excursion

2217 (setq p (point))

2218 (if (string-match "^/" be)

2219 (setq beg (progn (forward-line 1) (point)))

2220 (setq beg (progn (beginning-of-line) (point))))

2221 (goto-char p)

2222 (yahtml-goto-corresponding-begend)

2223 (if (string-match "^/" be)

2224 (beginning-of-line)

2225 (forward-line 1))

2226 (set-marker e (point))

2227 ;(comment-region beg (point) (if uncom (list 4)))))

2228 ))

2229 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2230 (setq beg (region-beginning))

2231 (set-marker e (region-end))))

2232 (if yahtml-translate-hyphens-when-comment-region

2233 (let ((yahtml-entity-reference-chars-alist-default nil)

2234 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2235 yahtml-entity-reference-chars-regexp

2236 yahtml-entity-reference-chars-reverse-regexp)

2237 (yahtml-entity-reference-chars-setup)

2238 (funcall

2239 (if uncom 'yahtml-translate-reverse-region

2240 'yahtml-translate-region)

2241 beg e)))

2242 (comment-region beg e (if uncom (list 4)))

2243 (set-marker e nil)))

2244

2245 (defun yahtml-uncomment-region ()

2246 (interactive)

2247 (yahtml-comment-region t))

2248

2249 ;;; ---------- translate to entity references ----------

2250 (defvar yahtml-entity-reference-chars-alist-default

2251 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2252 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2253 "Default translation table from character to entity reference")

2254 (defvar yahtml-entity-reference-chars-alist nil

2255 "*Translation table from character to entity reference")

2256 (defvar yahtml-entity-reference-chars-regexp nil)

2257 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2258

2259 (defun yahtml-entity-reference-chars-setup ()

2260 (let ((list (append yahtml-entity-reference-chars-alist-default

2261 yahtml-entity-reference-chars-alist)))

2262 (setq yahtml-entity-reference-chars-regexp "["

2263 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2264 (while list

2265 (setq yahtml-entity-reference-chars-regexp

2266 (concat yahtml-entity-reference-chars-regexp

2267 (char-to-string (car (car list))))

2268 yahtml-entity-reference-chars-reverse-regexp

2269 (concat yahtml-entity-reference-chars-reverse-regexp

2270 (cdr (car list))

2271 (if (cdr list) "\\|")))

2272 (setq list (cdr list)))

2273 (setq yahtml-entity-reference-chars-regexp

2274 (concat yahtml-entity-reference-chars-regexp "]")

2275 yahtml-entity-reference-chars-reverse-regexp

2276 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2277

2278 (yahtml-entity-reference-chars-setup)

2279

2280 (defun yahtml-translate-region (beg end)

2281 "Translate inhibited literals."

2282 (interactive "r")

2283 (save-excursion

2284 (save-restriction

2285 (narrow-to-region beg end)

2286 (let ((ct (append yahtml-entity-reference-chars-alist

2287 yahtml-entity-reference-chars-alist-default)))

2288 (goto-char beg)

2289 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2290 ;(setq c (preceding-char))

2291 (replace-match

2292 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2293

2294 (defun yahtml-translate-reverse-region (beg end)

2295 "Translate entity references to literals."

2296 (interactive "r")

2297 (save-excursion

2298 (save-restriction

2299 (narrow-to-region beg end)

2300 (let ((ct (append yahtml-entity-reference-chars-alist

2301 yahtml-entity-reference-chars-alist-default))

2302 ec)

2303 (goto-char beg)

2304 (while (re-search-forward

2305 yahtml-entity-reference-chars-reverse-regexp nil t)

2306 ;(setq c (preceding-char))

2307 (setq ec (YaTeX-match-string 1))

2308 (delete-region (match-end 0) (match-beginning 0))

2309 (insert (car (YaTeX-rassoc ec ct))))))))

2310

2311 (defun yahtml-inner-environment-but (exclude &optional quick)

2312 "Return the inner environment but matches with EXCLUDE tag."

2313 (let (e (case-fold-search t))

2314 (save-excursion

2315 (while (and (setq e (YaTeX-inner-environment quick))

2316 (string-match exclude e))

2317 (goto-char (get 'YaTeX-inner-environment 'point))))

2318 e))

2319

2320 (defun yahtml-untranslate-string (str)

2321 "Untranslate entity reference."

2322 (let ((md (match-data)) (left "") (right str) b0 ch

2323 (ct (append yahtml-entity-reference-chars-alist

2324 yahtml-entity-reference-chars-alist-default))

2325 (revrex yahtml-entity-reference-chars-reverse-regexp))

2326 (unwind-protect

2327 (progn

2328 (while (string< "" right)

2329 (cond

2330 ((string-match revrex right)

2331 (setq ch (YaTeX-rassoc

2332 (substring right (match-beginning 1) (match-end 1)))

2333 b0 (substring right 0 (match-beginning 0))

2334 right (substring right (match-end 0))

2335 left (concat left

2336 (substring right 0 (match-beginning 0))

2337 (char-to-string ch))))

2338 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2339 (setq ch (substring right (match-beginning 2) (match-end 2))

2340 b0 (substring right 0 (match-beginning 0))

2341 right (substring right (match-end 0))

2342 left (concat left

2343 b0

2344 (char-to-string

2345 (if (match-beginning 1)

2346 (YaTeX-hex ch)

2347 (string-to-number ch))))))

2348 (t (setq left (concat left right)

2349 right ""))))

2350 left)

2351 (store-match-data md))))

2352

2353 ;;; ---------- table-ize region ----------

2354 (defun yahtml-td-region (e delim beg end)

2355 "Enclose each item in a region with <td>..</td>.

2356 Interactive prefix argument consults enclosing element other than td."

2357 (interactive "P\nsDelimiter(s): \nr")

2358 (let ((e (cond

2359 ((null e) "td")

2360 ((stringp e) e)

2361 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2362 (ws "[ \t]")

2363 elm p i)

2364 (if (string= delim "") (setq delim " \t\n"))

2365 (setq delim (concat "[" delim "]+")

2366 elm (if (string= "thd" e)

2367 (cons "th" "td")

2368 (cons e e)))

2369 (save-excursion

2370 (save-restriction

2371 (narrow-to-region beg end)

2372 (goto-char (setq p (point-min)))

2373 (setq i 0 e (car elm))

2374 (while (re-search-forward delim nil t)

2375 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2376 (goto-char (match-beginning 0))

2377 (insert "</" e ">")

2378 (save-excursion

2379 (goto-char p)

2380 (insert "<" e ">"))

2381 (setq p (point))

2382 (while (and (not (eobp)) (looking-at ws))

2383 (delete-char 1))

2384 (if (looking-at delim) (delete-char 1)))

2385 (insert "<" e ">")

2386 (goto-char (point-max))

2387 (insert "</" e ">")))))

2388

2389 (defun yahtml-tr-region (e delim beg end)

2390 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2391 (interactive "P\nsDelimiter(s): \nr")

2392 (setq e (if (and e (listp e))

2393 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2394 "th")))

2395 (save-excursion

2396 (save-restriction

2397 (narrow-to-region (point) (mark))

2398 (goto-char (point-min))

2399 (while (not (eobp))

2400 (insert "<tr>")

2401 (yahtml-td-region e delim (point) (point-end-of-line))

2402 (end-of-line)

2403 (insert "</tr>")

2404 (forward-line 1)))))

2405

2406 ;;; ---------- filling ----------

2407 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2408 (defun yahtml-move-to-column (col &optional force)

2409 (beginning-of-line)

2410 (let ((ccol 0))

2411 (while (and (> col ccol) (not (eolp)))

2412 (if (eq (following-char) ?\<)

2413 (progn

2414 (while (and (not (eq (following-char) ?\>))

2415 (not (eolp)))

2416 (forward-char))

2417 (or (eolp) (forward-char)))

2418 (or (eolp) (forward-char))

2419 (if (eq (preceding-char) ?\t)

2420 (let ((wd (- 8 (% (+ ccol 8) 8))))

2421 (if (and force (< col (+ ccol wd)))

2422 (progn

2423 (backward-char 1)

2424 (insert-char ?\ (- col ccol))

2425 (setq ccol col))

2426 (setq ccol (+ ccol wd))))

2427 (setq ccol (1+ ccol)))

2428 (if (and YaTeX-japan

2429 (or

2430 (and (fboundp 'char-category)

2431 (string-match "[chj]" (char-category (preceding-char))))

2432 (and (fboundp 'char-charset)

2433 (not (eq (char-charset (preceding-char)) 'ascii)))))

2434 (setq ccol (1+ ccol)))))

2435 (if (and force (> col ccol))

2436 (progn

2437 (insert-char ?\ (- col ccol))

2438 col)

2439 ccol)))

2440

2441 (defun yahtml-fill-paragraph (arg)

2442 (interactive "P")

2443 (let*((case-fold-search t) (p (point)) fill-prefix

2444 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2445 indent

2446 (startp (get 'YaTeX-inner-environment 'point))

2447 (prep (string-match "^pre$" e))

2448 (ps1 (if prep (default-value 'paragraph-start)

2449 paragraph-start))

2450 (ps2 (if prep (concat (default-value 'paragraph-start)

2451 "$\\|^\\s *</?pre>")

2452 paragraph-start)))

2453 (save-excursion

2454 (unwind-protect

2455 (progn

2456 (if prep

2457 (fset 'move-to-column 'yahtml-move-to-column))

2458 (save-excursion

2459 (beginning-of-line)

2460 (indent-to-column (yahtml-this-indent))

2461 (setq fill-prefix

2462 (buffer-substring (point) (point-beginning-of-line)))

2463 (delete-region (point) (point-beginning-of-line)))

2464 (fill-region-as-paragraph

2465 (progn (re-search-backward paragraph-start nil t)

2466 (or (save-excursion

2467 (goto-char (match-beginning 0))

2468 (if (looking-at "<")

2469 (forward-list)

2470 (goto-char (match-end 0))

2471 (skip-chars-forward " \t>"))

2472 (if (looking-at "[ \t]*$")

2473 (progn (forward-line 1) (point))))

2474 (point)))

2475 (progn (goto-char p)

2476 (re-search-forward ps2 nil t)

2477 (match-beginning 0))))

2478 (fset 'move-to-column yahtml-saved-move-to-column)))))

2479

2480 ;(defun yahtml-indent-new-commnet-line ()

2481 ; (unwind-protect

2482 ; (progn

2483 ; (fset 'move-to-column 'yahtml-move-to-column)

2484 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2485 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2486

2487 ;;;

2488 ;;; ---------- indentation ----------

2489 ;;;

2490 (defun yahtml-indent-line ()

2491 "Indent a line (faster wrapper)"

2492 (interactive)

2493 (let (indent)

2494 (if (and (save-excursion

2495 (beginning-of-line) (skip-chars-forward "\t ")

2496 (not (looking-at "<")))

2497 (save-excursion

2498 (forward-line -1)

2499 (while (and (not (bobp)) (looking-at "^\\s *$"))

2500 (forward-line -1))

2501 (skip-chars-forward "\t ")

2502 (setq indent (current-column))

2503 (not (looking-at "<"))))

2504 (progn

2505 (save-excursion

2506 (beginning-of-line)

2507 (skip-chars-forward " \t")

2508 (or (= (current-column) indent)

2509 (YaTeX-reindent indent)))

2510 (and (bolp) (skip-chars-forward " \t")))

2511 (yahtml-indent-line-real))))

2512

2513 (defun yahtml-this-indent ()

2515 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2516 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2517 (excludes

2518 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2519 inenv p col peol (case-fold-search t))

2520 (save-excursion

2521 (beginning-of-line)

2522 (setq inenv (or (yahtml-inner-environment-but excludes t)

2523 "html")

2524 col (get 'YaTeX-inner-environment 'indent)

2525 p (get 'YaTeX-inner-environment 'point)

2526 op nil))

2527 (save-excursion

2528 (cond

2529 ((string-match (concat "^\$" envs "\$") inenv)

2530 (save-excursion

2531 (beginning-of-line)

2532 (skip-chars-forward " \t")

2533 (cond ;lookup current line's tag

2534 ((looking-at (concat "</\$" envs "\$>"))

2535 col)

2536 ((looking-at itms)

2537 (+ col yahtml-environment-indent))

2538 ((and yahtml-hate-too-deep-indentation

2539 (looking-at (concat "<\$" envs "\$")))

2540 (+ col (* 2 yahtml-environment-indent)))

2541 ((and (< p (point))

2542 (string-match itemizing-envs inenv)

2543 (save-excursion

2544 (and

2545 (setq op (point))

2546 (goto-char p)

2547 (re-search-forward itms op t)

2548 (progn

2549 (if yahtml-indent-listing-constant

2550 (setq col (+ (current-column)

2551 (if yahtml-faithful-to-htmllint 1 2)))

2552 (skip-chars-forward "^>")

2553 (skip-chars-forward ">")

2554 (skip-chars-forward " \t")

2555 (setq col (if (looking-at "$")

2556 (+ col yahtml-environment-indent)

2557 (current-column))))))))

2558 col)

2559 (t

2560 (+ col yahtml-environment-indent)))))

2561 (t col)))))

2562

2563 (defun yahtml-indent-line-real ()

2564 "Indent current line."

2565 (interactive)

2566 (YaTeX-reindent (yahtml-this-indent))

2567 (if (bolp) (skip-chars-forward " \t"))

2568 (let (peol col inenv)

2569 (if (and (setq inenv (yahtml-on-begend-p))

2570 (string-match

2571 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2572 (save-excursion

2573 (setq peol (point-end-of-line))

2574 (or (= (char-after (point)) ?<)

2575 (progn (skip-chars-backward "^<") (forward-char -1)))

2576 (setq col (current-column))

2577 (if (and (yahtml-goto-corresponding-begend t)

2578 (> (point) peol)) ;if on the different line

2579 (YaTeX-reindent col))))))

2580

2581 ;(defun yahtml-fill-item ()

2582 ; "Fill item HTML version"

2583 ; (interactive)

2584 ; (let (inenv p fill-prefix peol (case-fold-search t))

2585 ; (setq inenv (or (YaTeX-inner-environment) "html")

2586 ; p (get 'YaTeX-inner-environment 'point))

2587 ; (cond

2588 ; ((string-match "^[uod]l" inenv)

2589 ; (save-excursion

2590 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2591 ; (progn

2592 ; (goto-char (match-end 0))

2593 ; (setq col (current-column)))

2594 ; (error "No <li>, <dt>, <dd>")))

2595 ; (save-excursion

2596 ; (end-of-line)

2597 ; (setq peol (point))

2598 ; (newline)

2599 ; (indent-to-column col)

2600 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2601 ; (delete-region (point) peol)

2602 ; (fill-region-as-paragraph

2603 ; (progn (re-search-backward paragraph-start nil t) (point))

2604 ; (progn (re-search-forward paragraph-start nil t 2)

2605 ; (match-beginning 0)))))

2606 ; (t nil))))

2607

2608 ;;;

2609 ;;; ---------- Lint and Browsing ----------

2610 ;;;

2611 (defun yahtml-browse-menu ()

2612 "Browsing or other external process invokation menu."

2613 (interactive)

2614 (message "J)weblint p)Browse R)eload N)ewpage...")

2615 (let ((c (char-to-string (read-char))))

2616 (cond

2617 ((string-match "j" c)

2618 (yahtml-lint-buffer (current-buffer)))

2619 ((string-match "[bp]" c)

2620 (yahtml-browse-current-file))

2621 ((string-match "r" c)

2622 (yahtml-browse-reload))

2623 ((string-match "n" c)

2624 (call-interactively 'yahtml-newpage)))))

2625

2626 (if (fboundp 'wrap-function-to-control-ime)

2627 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2628

2629 (defvar yahtml-lint-buffer "*weblint*")

2630

2631 (defun yahtml-lint-buffer (buf)

2632 "Call lint on buffer BUF."

2633 (require 'yatexprc)

2634 (interactive "bCall lint on buffer: ")

2635 (setq buf (get-buffer buf))

2636 (YaTeX-save-buffers)

2637 (let ((bcmd (YaTeX-get-builtin "lint")))

2638 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2639 (YaTeX-typeset

2640 (concat (or bcmd yahtml-lint-program)

2641 " " (file-name-nondirectory (buffer-file-name buf)))

2642 yahtml-lint-buffer "lint" "lint")))

2643

2644 (defun yahtml-file-to-url (file)

2645 "Convert local unix file name to URL.

2646 If no matches found in yahtml-path-url-alist, return raw file name."

2647 (let ((list yahtml-path-url-alist) p url)

2648 (if (file-directory-p file)

2649 (setq file (expand-file-name yahtml-directory-index file))

2650 (setq file (expand-file-name file)))

2651 (if (string-match "^[A-Za-z]:/" file)

2652 (progn

2653 ;; (aset file 1 ?|) ;これは要らないらしい…

2654 (setq file (concat "///" file))))

2655 (while list

2656 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2657 (setq url (cdr (car list))

2658 file (substring file (match-end 0))

2659 url (concat url file)

2660 list nil))

2661 (setq list (cdr list)))

2662 (or url (concat "file:" file))))

2663

2664 (defun yahtml-url-to-path (file &optional basedir)

2665 "Convert local URL name to unix file name."

2666 (let ((list yahtml-path-url-alist) url realpath docroot

2667 (dirsufp (string-match "/$" file)))

2668 (setq basedir (or basedir

2669 (file-name-directory

2670 (expand-file-name default-directory))))

2671 (cond

2672 ((string-match "^/" file)

2673 (while list

2674 (if (file-directory-p (car (car list)))

2675 (progn

2676 (setq url (cdr (car list)))

2677 (if (string-match "\$http://[^/]*\$/" url)

2678 (setq docroot (substring url (match-end 1)))

2679 (setq docroot url))

2680 (cond

2681 ((string-match (concat "^" (regexp-quote docroot)) file)

2682 (setq realpath

2683 (expand-file-name

2684 (substring

2685 file

2686 (if (= (aref file (1- (match-end 0))) ?/)

2687 (match-end 0) ; "/foo"

2688 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2689 (car (car list))))))

2690 (if realpath

2691 (progn (setq list nil)

2692 (if (and dirsufp (not (string-match "/$" realpath)))

2693 (setq realpath (concat realpath "/")))))))

2694 (setq list (cdr list)))

2695 realpath)

2696 (t file))))

2697

2698 (defun yahtml-browse-current-file ()

2699 "Call WWW browser on current file."

2700 (interactive)

2701 (basic-save-buffer)

2702 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2703

2704 (defun yahtml-browse-reload ()

2705 "Send `reload' event to netscape."

2706 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2707 (cond

2708 ((string-match "[Nn]etscape" yahtml-www-browser)

2709 (if (get-buffer pb)

2710 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2711 ;;(or (get 'yahtml-netscape-sentinel 'url)

2712 ;; (error "Reload should be called after Browsing."))

2713 (put 'yahtml-netscape-sentinel 'url

2714 (yahtml-file-to-url (buffer-file-name)))

2715 (basic-save-buffer)

2716 (set-process-sentinel

2717 (setq yahtml-browser-process

2718 (start-process

2719 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2720 (format "%s -remote 'reload'" yahtml-www-browser)))

2721 'yahtml-netscape-sentinel))

2722 (t

2723 (message "Sorry, RELOAD is supported only for Netscape.")))))

2724

2725 ;;; ---------- Intelligent newline ----------

2726 (defun yahtml-intelligent-newline (arg)

2727 "Intelligent newline for HTML"

2728 (interactive "P")

2729 (let (env func)

2730 (end-of-line)

2731 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2732 "html")))

2733 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2734 (newline)

2735 (if (and env func (fboundp func))

2736 ;; if intelligent line function is defined, call that

2737 (funcall func)

2738 ;; else do the default action

2739 (if (string-match yahtml-p-prefered-env-regexp env)

2740 (yahtml-insert-p)))))

2741

2742 (defun yahtml-intelligent-newline-ul ()

2743 (interactive)

2744 (yahtml-insert-single "li")

2745 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2746 (yahtml-indent-line))

2747

2748 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2749

2750 (defun yahtml-intelligent-newline-dl ()

2751 (interactive)

2752 (let ((case-fold-search t))

2753 (if (save-excursion

2754 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2755 (get 'YaTeX-inner-environment 'point) t))

2756 (cond

2757 ((match-beginning 2)

2758 (yahtml-insert-single "dd")

2759 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2760 (setq yahtml-last-single-cmd "dt"))

2761 ((match-beginning 3)

2762 (yahtml-insert-single "dt")

2763 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2764 (setq yahtml-last-single-cmd "dd")))

2765 (yahtml-insert-single "dt")

2766 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2767 (setq yahtml-last-single-cmd "dd"))

2768 (yahtml-indent-line)

2769 (and (string-match yahtml-p-prefered-env-regexp "dl")

2770 (string-equal yahtml-last-single-cmd "dt")

2771 (yahtml-insert-p nil))))

2772

2773 (defun yahtml-intelligent-newline-select ()

2774 (interactive)

2775 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2776 (yahtml-indent-line))

2777

2778 (defun yahtml-intelligent-newline-style ()

2779 (interactive)

2780 (if (save-excursion

2781 (and

2782 (re-search-backward "<style\\|<!-- " nil t)

2783 (looking-at "<style")))

2784 (let (c)

2785 (yahtml-indent-line)

2786 (setq c (current-column))

2787 (insert "<!--\n")

2788 (YaTeX-reindent c)

2789 (insert "-->")

2790 (beginning-of-line)

2791 (open-line 1)

2792 (YaTeX-reindent c))))

2793

2794 (defun yahtml-intelligent-newline-head ()

2795 (let ((title (read-string "Document title: "))

2796 (b "<title>") (e "</title>") p)

2797 (yahtml-indent-line)

2798 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2799 (setq p (point))

2800 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2801 (if (string= "" title) (goto-char p))

2802 (setq yahtml-last-begend "body")))

2803

2804 (defun yahtml-intelligent-newline-script ()

2805 (let ((p (point)) b)

2806 (if (save-excursion

2807 (and

2808 (setq b (re-search-backward "<script\\>" nil t))

2809 (re-search-forward

2810 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2811 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2812 c (srcp (re-search-backward "src=" b t)))

2813 (goto-char p)

2814 (yahtml-indent-line)

2815 (setq c (current-column))

2816 (if srcp

2817 nil

2818 (insert "")

2819 (beginning-of-line)

2820 (open-line 1)

2821 (YaTeX-reindent c))))))

2822

2823 (defun yahtml-intelligent-newline-table ()

2824 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2825 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2826 (cond

2827 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2828 (while (and (setq rb (re-search-backward ptn tb t))

2829 (match-beginning 1))

2830 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2831 (goto-char (match-end 0))

2832 (skip-chars-forward " \t\n")

2833 (if (and (search-forward "colspan\\s *=" p t)

2834 (progn

2835 (skip-chars-forward "\"' \t\n")

2836 (looking-at "[0-9]+")))

2837 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2838 (setq cols (1+ cols)))

2839 (goto-char rb)

2840 (setq p (point)))

2841 (if (> cols 0)

2842 (message "%s columns found. %s"

2843 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2844 "New tr?(N) or Duplicate")))

2845 (cond

2846 ((and (> cols 0)

2847 (memq (read-char) '(?d ?D))) ;Duplication mode

2848 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2849 (t ;empty cells

2850 (setq line "<tr>" i 0)

2851 (if (> cols 0)

2852 (while (> cols i)

2853 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2854 "<td></td>"))

2855 th nil i (1+ i)))

2856 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2857 (while (string-match "t\$h\$\\|td" fmt i)

2858 (setq line (concat line (if (match-beginning 1) "<th></th>"

2859 "<td></td>"))

2860 i (match-end 0))))

2861 (setq line (concat line "</tr>"))))

2862 (goto-char cp)

2863 (if th

2864 (message

2865 "Type `%s' to change td from/to th."

2866 (key-description (car (where-is-internal 'yahtml-change-*)))))

2867 (if (string< "" line)

2868 (progn

2869 (insert line)

2870 (goto-char (+ 8 cp))

2871 (yahtml-indent-line)))))))

2872

2873 ;;; ---------- Marking ----------

2874 (defun yahtml-mark-begend ()

2875 "Mark current tag"

2876 (interactive)

2877 (YaTeX-beginning-of-environment)

2878 (let ((p (point)))

2879 (save-excursion

2880 (skip-chars-backward " \t" (point-beginning-of-line))

2881 (if (bolp) (setq p (point))))

2882 (push-mark p t))

2883 (yahtml-goto-corresponding-begend)

2884 (forward-list 1)

2885 (if (eolp) (forward-char 1)))

2886

2887 ;;; ---------- complete marks ----------

2888 (defun yahtml-complete-mark ()

2889 "Complete &gt, &lt, &ampersand, and &quote."

2890 (interactive)

2891 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2892 (let ((c (read-char)))

2893 (setq c (if (or (< c ?0) (> c ?7))

2894 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2895 (- c ?1)))

2896 (if (or (< c 0) (> c 6))

2897 nil

2898 (insert (format "&%s;"

2899 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2900

2901

2902 ;;; ---------- jump to error line ----------

2903 (defun yahtml-prev-error ()

2904 "Jump to previous error seeing lint buffer."

2905 (interactive)

2906 (or (get-buffer yahtml-lint-buffer)

2907 (error "No lint program ran."))

2908 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2909 (yahtml-jump-to-error-line t))

2910

2911 (defun yahtml-jump-to-error-line (&optional sit)

2912 (interactive "P")

2913 (let ((p (point)) (e (point-end-of-line)))

2914 (end-of-line)

2915 (if (re-search-backward yahtml-error-line-regexp nil t)

2916 (let ((f (if (string= "" (YaTeX-match-string 1))

2917 YaTeX-current-file-name

2918 (YaTeX-match-string 1)))

2919 (l (string-to-int (or (YaTeX-match-string 2)

2920 (YaTeX-match-string 3)))))

2921 (if sit (sit-for 1))

2922 (forward-line -1)

2923 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2924 (goto-line l))

2925 (message "No line number usage"))))

2926

2927 ;;; ---------- Style Sheet Support ----------

2928 (defvar yahtml-css-class-alist nil

2929 "Alist of elements vs. their classes")

2930

2931 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2932 (save-excursion

2933 (save-restriction

2934 (narrow-to-region beg end)

2935 (goto-char (point-min))

2936 (let ((alist initial) b e element class a)

2937 (setq b (point))

2938 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2939 (if (match-beginning 2)

2940 (let ((f (YaTeX-buffer-substring

2941 (progn (skip-chars-forward "^\"")(1+ (point)))

2942 (progn (forward-char 1)

2943 (skip-chars-forward "^\"")(point)))))

2944 (if (file-exists-p f)

2945 (setq alist

2946 (append alist (yahtml-css-collect-classes-file f)))))

2947 (setq e (point))

2948 (goto-char b)

2949 (while (re-search-forward ;ちょといい加減なREGEXP

2950 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2951 e t)

2952 (setq element (YaTeX-match-string 1)

2953 class (YaTeX-match-string 2))

2954 ;;if starts with period (match-string 1 is nil),

2955 ;;this is global class

2956 (setq element (downcase (or element "*")))

2957 (if (setq a (assoc element alist))

2958 (or (assoc class (cdr a))

2959 (setcdr a (cons (list class) (cdr a))))

2960 (setq alist (cons (list element (list class)) alist))))

2961 (goto-char (1- e))

2962 (search-forward "}" nil 1) ;1=move to limit when not found.

2963 (setq b (point))))

2964 alist))))

2965

2966 (defun yahtml-css-collect-classes-buffer (&optional initial)

2967 (interactive)

2968 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2969

2970 (defun yahtml-css-collect-classes-file (file &optional initial)

2971 (let*((hilit-auto-highlight nil)

2972 (buf (get-buffer-create

2973 (format " *css-collection*%s" (file-name-nondirectory file))))

2974 (cb (current-buffer)))

2975 (unwind-protect

2976 (progn

2977 (set-buffer buf)

2978 (insert-file-contents file)

2979 (cd (or (file-name-directory file) "."))

2980 (yahtml-css-collect-classes-buffer initial))

2981 (if (eq buf cb)

2982 nil

2983 (kill-buffer buf)

2984 (set-buffer cb)))))

2985

2986 (defun yahtml-css-scan-styles ()

2987 (save-excursion

2988 (goto-char (point-min))

2989 (set (make-local-variable 'yahtml-css-class-alist) nil)

2990 (let (b tag type e href alist)

2991 (while (re-search-forward "<\$style\\|link\$" nil t)

2992 (setq b (match-beginning 0)

2993 tag (YaTeX-match-string 1))

2994 (cond

2995 ((string-match "style" tag)

2996 (goto-char b)

2997 (save-excursion (forward-list 1) (setq e (point)))

2998 (cond

2999 ((search-forward "text/css" e 1) ;css definition starts

3000 (setq alist

3001 (yahtml-css-collect-classes-region

3002 (point) (progn (search-forward "</style>") (point))

3003 alist)))))

3004 ((and (string-match "link" tag)

3005 (stringp (setq type (yahtml-get-attrvalue "type")))

3006 (string-match "text/css" type)

3007 (setq href (yahtml-get-attrvalue "href"))

3008 (file-exists-p (yahtml-url-to-path href)))

3009 (setq alist

3010 (yahtml-css-collect-classes-file

3011 (yahtml-url-to-path href) alist))))

3012 (setq yahtml-css-class-alist alist)))))

3013

3014 (defun yahtml-css-get-element-completion-alist (element)

3015 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3016 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3017 (and (or alist global)

3018 (append alist global))))

3019

3020 ;;; ---------- ----------

3021

3022 ;;;

3023 ;;hilit19

3024 ;;;

3025 (defvar yahtml-default-face-table

3026 '(

3027 (form black/ivory white/hex-442233 italic)

3028 ))

3029 (defvar yahtml-hilit-patterns-alist

3030 '(

3031 'case-fold

3032 ;; comments

3033 ("" comment)

3034 ;; include&exec

3035 ("" include)

3036 ;; string

3037 (hilit-string-find ?\\ string)

3038 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3039 ("</?[uod]l>" 0 decl)

3040 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3041 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3042 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3043 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3044 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3045 ))

3046

3047 (defun yahtml-hilit-region-tag (tag)

3048 "Return list of start/end point of <TAG> form."

3049 (if (re-search-forward tag nil t)

3050 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3051 (elm (YaTeX-match-string 1)))

3052 (skip-chars-forward "^>")

3053 (prog1

3054 (cons (1+ (point))

3055 (progn (re-search-forward (concat "</" elm ">") nil t)

3056 (match-beginning 0)))

3057 (goto-char e0)))))

3058

3059 (defun yahtml-hilit-region-tag-itself (ptn)

3060 "Return list of start/end point of <tag options...> itself."

3061 (if (re-search-forward ptn nil t)

3062 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3063 (skip-chars-forward "^<>")

3064 (if (eq (char-after (point)) ?<) nil

3065 (prog1

3066 (cons m0 (min (point-max) (1+ (point))))

3067 (goto-char e0))))))

3068

3069 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3070 (and yahtml-use-hilit19

3071 (or (assq 'yahtml-mode hilit-patterns-alist)

3072 (setq hilit-patterns-alist

3073 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3074 hilit-patterns-alist))))

3075 ;;;

3076 ;; for font-lock

3077 ;;;

3078

3079 ; <<STATIC KEYWORDS BELOW NOT USED>>

3080 ;(defvar yahtml-font-lock-keywords

3081 ; '(

3082 ; ;; comments

3083 ; ("" . font-lock-comment-face)

3084 ; ;; include&exec

3085 ; (""

3086 ; 0 font-lock-include-face keep)

3087 ; ;; string

3088 ; ;(hilit-string-find ?\\ string)

3089 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3090 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3091 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3092 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3093 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3094 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3095 ; )

3096 ; "*Defualt font-lock-keywords for yahtml-mode.")

3097 (defvar yahtml-font-lock-keywords

3098 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3099 "Default fontifying patterns for yahtml-mode")

3100

3101 (defun yahtml-font-lock-set-default-keywords ()

3102 (put 'yahtml-mode 'font-lock-defaults

3103 '(yahtml-font-lock-keywords nil t)))

3104

3105 (if yahtml-use-font-lock

3106 (progn

3107 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3108 ;;for those who use both hilit19 and font-lock

3109 (if (eq (car hilit-mode-enable-list) 'not)

3110 (or (member 'yahtml-mode hilit-mode-enable-list)

3111 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3112 (setq hilit-mode-enable-list

3113 (delq 'yahtml-mode hilit-mode-enable-list))))

3114 (yahtml-font-lock-set-default-keywords)))

3115

3116 (defun yahtml-font-lock-recenter (&optional arg)

3117 (interactive "P")

3118 (font-lock-mode -1) ;is stupid, but sure.

3119 (font-lock-mode 1))

3120

3121 (run-hooks 'yahtml-load-hook)

3122 (provide 'yahtml)

3123

3124 ; Local variables:

3125 ; fill-prefix: ";;; "

3126 ; paragraph-start: "^$\\|\\|;;;$"

3127 ; paragraph-separate: "^$\\|\\|;;;$"

3128 ; coding: sjis

3129 ; End: