yatex: c44910b36b95 yahtml.el

yatex

view yahtml.el @ 392:c44910b36b95

Switch to region-mode if completion called with active region.

author	HIROSE Yuuji <yuuji@gentei.org>
date	Thu, 15 Jan 2015 23:21:24 +0900
parents	77a2fd4fd634
children	67fa6d791bc9

line source

1 ;;; yahtml.el --- Yet Another HTML mode -*- coding: sjis -*-

3 ;;; Last modified Thu Jan 15 11:34:59 2015 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.77"

7 "Revision number of running yahtml.el")

9 ;;; Commentary:

11 ;;;[Installation]

12 ;;;

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

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

15 ;;;

16 ;;; (setq auto-mode-alist

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

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

19 ;;; (setq yahtml-www-browser "firefox")

20 ;;; ;Write your favorite browser. But firefox is advantageous.

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

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

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

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

25 ;;;

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

27 ;;;

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

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

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

31 ;;;

32 ;;; (setq auto-mode-alist

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

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

35 ;;; (setq yahtml-www-browser "firefox")

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

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

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

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

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

41 ;;;

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

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

44 ;;;

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

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

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

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

49 ;;;

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

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

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

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

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

55 ;;;

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

57 ;;;

58 ;;;[Commentary]

59 ;;;

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

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

62 ;;;

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

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

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

66 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

91 ;;; change the reference link with completion.

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

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

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

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

96 ;;; is "firefox")

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

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

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

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

101 ;;; in the region.

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

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

104 ;;; URLencoded string in the region.

105 ;;;

106 ;;;[キーの説明]

107 ;;;

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

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

110 ;;;

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

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

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

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

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

116 ;;; できます。

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

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

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

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

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

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

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

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

125 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

137 ;;; す。

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

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

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

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

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

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

144 ;;; きます。

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

146 ;;; す。ファイル先頭付近に

147 ;;;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

168 ;;;

169 ;;; [謝辞]

170 ;;;

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

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

173 ;;;

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

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

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

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

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

179 ;;;

180

181 ;;; Code:

182

183 (require 'yatexlib)

184 ;;; --- customizable variable starts here ---

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

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

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

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

189 (defvar yahtml-kanji-code 2

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

191 ;;(defvar yahtml-coding-system

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

193 ;; "Kanji coding system")

194 (and (featurep 'mule)

195 (integerp yahtml-kanji-code)

196 (setq yahtml-kanji-code

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

198

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

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

201

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

203 (defvar yahtml-path-url-alist nil

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

205 Ex.

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

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

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

209 "*Directory index file name;

210 Consult your site's WWW administrator.")

211

212 (defvar yahtml-environment-indent 1

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

214

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

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

217 "*Program name to lint HTML file")

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

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

220

221 (defvar yahtml-always-/p t

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

223 (defvar yahtml-always-/li nil

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

225 (defvar yahtml-always-/dt nil

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

227 (defvar yahtml-always-/dd nil

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

229

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

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

232

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

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

235

236 (defvar yahtml-prefer-upcases nil

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

238

239 (defvar yahtml-prefer-upcase-attributes nil

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

241

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

243

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

245 "*Server access file name for apache")

246

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

248

249 (defvar yahtml-image-inspection-bytes 500000

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

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

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

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

254 %f: filename")

255

256 (defvar yahtml-faithful-to-htmllint yahtml-always-/li

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

258

259 (defvar yahtml-error-line-regexp

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

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

262

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

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

265 (defvar yahtml-escape-chars 'ask

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

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

268 at each reserved chars.")

269

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

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

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

273

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

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

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

277

278 (defvar yahtml-mode-abbrev-table nil

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

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

281

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

283 "*Boundary regexp for indentation calculation.")

284

285 (defvar yahtml-html4-strict t

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

287 Completing read for obsoleted attributes disabled.")

288

289 ;;; --- customizable variable ends here ---

290 (defvar yahtml-prefix-map nil)

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

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

293 (defvar yahtml-shell-command-option

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

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

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

297

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

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

300 (YaTeX-define-key

301 key

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

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

304 map))

305

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

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

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

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

310

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

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

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

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

315 (if YaTeX-inhibit-prefix-letter nil

316 (yahtml-define-begend-region-key

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

318

319 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

332 (let ((map yahtml-prefix-map))

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

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

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

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

337 (and YaTeX-emacs-19 window-system

338 (progn

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

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

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

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

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

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

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

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

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

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

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

350 (if YaTeX-no-begend-shortcut

351 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

390 (substitute-all-key-definition

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

392 (substitute-all-key-definition

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

394

395 (if yahtml-lint-buffer-map nil

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

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

398

399

400 (defvar yahtml-paragraph-start

401 (concat

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

403 "*Regexp of html paragraph separater")

404 (defvar yahtml-paragraph-separate

405 (concat

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

407 "*Regexp of html paragraph separater")

408 (defvar yahtml-syntax-table nil

409 "*Syntax table for yahtml-mode")

410

411 (if yahtml-syntax-table nil

412 (setq yahtml-syntax-table

413 (make-syntax-table (standard-syntax-table)))

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

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

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

417

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

419 "Regexp of constituent of html commands.")

420

421 ;;; Completion tables for `form'

422 (defvar yahtml-form-table

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

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

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

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

427

428 (defvar yahtml-env-table

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

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

431 ("OrderedList" . "ol")

432 ("UnorderedList" . "ul")

433 ("DefinitionList" . "dl")

434 ("Preformatted" . "pre")

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

436 ("address") ("button")

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

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

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

440 ("option")

441 ))

442

443 (if yahtml-html4-strict

444 (setq yahtml-env-table

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

446

447 ;(defvar yahtml-itemizing-regexp

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

449 ; "Regexp of itemizing forms")

450

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

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

453

454 ;;; Completion tables for typeface designator

455 (and yahtml-always-/p

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

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

458 (and yahtml-always-/li

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

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

461 (and yahtml-always-/dt

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

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

464 (and yahtml-always-/dd

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

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

467

468 (defvar yahtml-typeface-table

469 (append

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

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

472 ("sup") ("sub") ("span") ("abbr"))

473 (if (not yahtml-html4-strict)

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

475 yahtml-env-table)

476 "Default completion table of typeface designator")

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

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

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

480

481 (defvar yahtml-single-cmd-table

482 '(("hr") ("br") ("option")

483 ("HorizontalRule" . "hr")

484 ("BreakLine" . "br")

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

486 ("!--#exec")

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

488 ("!--#include")

489 ;; ("Item" . "li")

490 ;; ("DefineTerm" . "dt")

491 ;; ("Description" . "dd")

492 ;; ("dd") ("dt") ("li")

493 )

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

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

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

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

498

499 (defvar yahtml-current-completion-type nil

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

501

502 (defvar yahtml-struct-name-regexp

503 (concat

504 "\\<\\("

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

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

507 "\\)\\b")

508 "Regexp of structure beginning.")

509

510 (defvar yahtml-closable-regexp

511 (concat

512 "\\<\\("

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

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

515 "\\)\\b")

516 "Regexp of any closable elemnts.")

517

518 (defvar yahtml-indent-listing-constant t

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

520 T for static indentation depth")

521

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

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

524

525

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

527 (cond

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

529 buffer-file-name)

530 (let ((dir default-directory)

531 charset af ext (ldir "")

532 line

533 (case-fold-search t)

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

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

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

537 (while (and dir

538 (not (string= dir ldir))

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

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

541 (if (file-exists-p af)

542 (save-excursion

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

544 (save-excursion

545 (goto-char (point-min))

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

547 (setq line (buffer-substring

548 (point-beginning-of-line)

549 (point-end-of-line))

550 dir nil)))

551 (kill-buffer (current-buffer))))

552 (if dir

553 (setq ldir dir

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

555 dir (file-name-directory dir))))

556 line))

557 (t nil)))

558

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

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

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

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

563 (case-fold-search t)

564 line

565 charset)

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

567 (progn

568 (string-match ptn line)

569 (setq charset

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

571 (cond

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

573 (setq charset 2))

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

575 (setq charset 3))

576 ((string-match "shift_jis" charset)

577 (setq charset 1))

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

579 (setq charset 4))

580 (t (setq charset nil)))

581 (setq dir "")))

582 (if (featurep 'mule)

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

584 charset))

585

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

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

588 x index-list)

589 ;;s/\\s *$//;

590 (if line

591 (progn

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

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

594 (while (string< "" line)

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

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

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

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

599 line "")))

600 (or (nreverse index-list)

601 (if (listp yahtml-directory-index)

602 yahtml-directory-index

603 (list yahtml-directory-index)))))))

604

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

606 (defun yahtml-mode ()

607 (interactive)

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

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

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

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

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

613 (cond

614 ((null coding) nil)

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

616 (setq buffer-file-coding-system

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

618 (save-excursion

619 (goto-char (point-min))

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

621 coding)))

622 ((featurep 'mule)

623 (set-file-coding-system coding))

624 ((boundp 'NEMACS)

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

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

627 (setq major-mode 'yahtml-mode

628 mode-name "yahtml"

629 YaTeX-current-file-name (file-name-nondirectory

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

631 local-abbrev-table yahtml-mode-abbrev-table)

632 (mapcar

633 (function (lambda (x)

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

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

636 (boundp (cdr x)))

637 (symbol-value (cdr x))

638 (cdr x)))))

639 '((YaTeX-ec . "")

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

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

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

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

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

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

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

647 (paragraph-start . yahtml-paragraph-start)

648 (paragraph-separate . yahtml-paragraph-separate)

649 (comment-start . "")

650 (comment-start-skip . comment-start)

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

652

653 (if yahtml-use-font-lock

654 (progn

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

656 (or (featurep 'xemacs)

657 (progn

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

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

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

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

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

663 (font-lock-fontify-buffer)))))

664 ;; +dnd for X11 w/ emacs23+

665 (and window-system (featurep 'dnd)

666 (set (make-local-variable 'dnd-protocol-alist)

667 (cons (cons "^\$file\\|https?\$:" 'yahtml-dnd-handler)

668 dnd-protocol-alist)))

669

670 (set-syntax-table yahtml-syntax-table)

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

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

673 (yahtml-css-scan-styles)

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

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

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

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

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

679

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

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

682 font-lock-defaults)

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

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

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

686

687 (defun yahtml-version ()

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

689 (interactive)

690 (message

691 (concat "Yet Another HTML-mode "

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

693 " Revision "

694 yahtml-revision-number)))

695

696 (defun yahtml-quit ()

697 (interactive)

698 (and yahtml-mode-old-mode

699 (fboundp yahtml-mode-old-mode)

700 (funcall yahtml-mode-old-mode)))

701

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

703 (cond

704 ((featurep 'xemacs)

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

706 (set keymap nil)

707 (mapcar

708 (function

709 (lambda (bind)

710 (setq bind (cdr bind))

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

712 (setcar (cdr bind) 'progn))

713 (if (stringp (car (cdr bind)))

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

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

716 (symbol-value keymap))))))

717 bindlist)

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

719 (t

720 (mapcar

721 (function

722 (lambda (bind)

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

724 bindlist))))

725

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

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

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

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

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

731

732 ;;; Variables for mosaic url history

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

734 (defvar yahtml-urls-private nil)

735 (defvar yahtml-urls-local nil)

736

737 (cond

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

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

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

741 (YaTeX-define-menu

742 'yahtml-menu-map-sectioning

743 (nreverse

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

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

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

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

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

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

750 )))

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

752 (YaTeX-define-menu

753 'yahtml-menu-map-logical

754 (nreverse

755 '((em "Embolden" .

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

757 (dfn "Define a word" .

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

759 (cite "Citation" .

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

761 (code "Code" .

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

763 (kbd "Keyboard" .

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

765 (samp "Sample display" .

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

767 (strong "Strong" .

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

769 (VAR "Variable notation" .

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

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

772 (YaTeX-define-menu

773 'yahtml-menu-map-typeface

774 (nreverse

775 '((b "Bold" .

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

777 (i "Italic" .

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

779 (tt "Typewriter" .

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

781 (u "Underlined" .

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

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

784 (YaTeX-define-menu

785 'yahtml-menu-map-listing

786 (nreverse

787 '((ul "Unordered" .

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

789 (ol "Ordered" .

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

791 (dl "Definition" .

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

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

794 (YaTeX-define-menu

795 'yahtml-menu-map-item

796 (nreverse

797 '((li "Simple item" .

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

799 (dt "Define term" .

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

801 (dd "Description of term" .

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

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

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

805 (YaTeX-define-menu

806 'yahtml-menu-map

807 (nreverse

808 (list

809 (cons (list 'sect "Sectioning")

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

811 (cons (list 'list "Listing")

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

813 (cons (list 'item "Item")

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

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

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

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

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

819 (if (featurep 'xemacs)

820 (add-hook 'yahtml-mode-hook

821 (function

822 (lambda ()

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

824 (progn

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

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

827

828 ;;; ----------- Completion ----------

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

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

831 "Insert <cmd> ... </cmd>."

832 (interactive "P")

833 (setq yahtml-current-completion-type 'multiline

834 region (or region (YaTeX-region-active-p)))

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

836 (cmd

837 (or env

838 (YaTeX-cplread-with-learning

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

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

841 (bolp (save-excursion

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

843 (cc (current-column)))

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

845 (setq yahtml-last-begend

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

847 yahtml-last-begend))

848 (setq cmd yahtml-last-begend)

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

850 (if region

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

852 ;; to enable continuous regioning by another environment

853 (let ((beg (region-beginning))

854 (end (region-end))

855 (addin (yahtml-addin cmd)))

856 (save-excursion

857 (goto-char end)

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

859 (goto-char beg)

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

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

862 (save-excursion

863 (insert "\n")

864 (indent-to-column cc)

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

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

867 (newline)

868 (yahtml-intelligent-newline nil))

869 (yahtml-indent-line))))

870

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

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

873 (interactive)

874 (yahtml-insert-begend t))

875

876

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

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

879 (interactive)

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

881 (or form

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

883 (setq form

884 (YaTeX-cplread-with-learning

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

886 'yahtml-form-table 'yahtml-user-form-table

887 'yahtml-tmp-form-table))))

888 (let ((p (point)) q)

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

890 (setq yahtml-last-form form)

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

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

893 ;;(indent-relative-maybe)

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

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

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

897

898 (defun yahtml-read-css (alist)

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

900 (minibuffer-completion-table alist))

901 (read-from-minibuffer

902 (substitute-command-keys

903 (if YaTeX-japan

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

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

906 nil YaTeX-minibuffer-completion-map nil)))

907

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

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

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

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

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

913 (defun yahtml-newpage (file ov)

914 "Create newpage via newpage script"

915 (interactive

916 (list

917 (let (insert-default-directory)

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

919 current-prefix-arg))

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

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

922 (insert (substring

923 (YaTeX-command-to-string

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

925 0 -1)))

926

927 ;;; ---------- Add-in ----------

928 (defun yahtml-addin (form)

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

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

931 (concat

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

933 (not (equal (YaTeX-last-key) ?\C-j))

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

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

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

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

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

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

940 (string< "" s))

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

942 ""))))

943

944 (defvar yahtml-completing-buffer nil)

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

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

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

948 (let (list end)

949 (save-excursion

950 (set-buffer yahtml-completing-buffer)

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

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

953 (save-excursion

954 (goto-char (point-min))

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

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

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

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

959 (setq end (match-end 0))

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

961 (yahtml-on-assignment-p)

962 (progn

963 (goto-char end)

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

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

966 (setq list (cons

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

968 list))))

969 list))))

970

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

972 (if yahtml-url-completion-map nil

973 (setq yahtml-url-completion-map

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

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

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

977

978 (defun yahtml-complete-url ()

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

980 (interactive)

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

982 (lim (YaTeX-minibuffer-begin))

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

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

985 (cond

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

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

988 listfunc (list 'lambda nil

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

990 beg min))

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

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

993 (progn

994 (setq path (substring initial 0 beg))

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

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

997 (setq initial (substring initial beg))

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

999 cmpl (try-completion initial labels)

1000 listfunc (list 'lambda ()

1001 (list 'all-completions

1002 initial (list 'quote labels)))

1003 beg (+ min beg)))

1004 (t

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

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

1007 initial))

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

1009 file (file-name-nondirectory path)

1010 initial file

1011 cmpl (file-name-completion file dir)

1012 listfunc (list 'lambda nil

1013 (list 'file-name-all-completions

1014 file dir))

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

1016 (cond

1017 ((stringp cmpl)

1018 (if (string= initial cmpl)

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

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

1021 (princ

1022 (mapconcat (function(lambda (x) x)) (funcall listfunc) "\n")))

1023 (delete-region (point) beg)

1024 (insert cmpl)))

1025 ((null cmpl)

1026 (ding))

1027 ((eq t cmpl)

1028 (save-excursion

1029 (unwind-protect

1030 (progn

1031 (goto-char p)

1032 (insert " [Sole completion]"))

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

1034

1035 ;

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

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

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

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

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

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

1042 ;

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

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

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

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

1047 (defvar yahtml-unsafe-chars-regexp

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

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

1050 ;

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

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

1053 ;

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

1055 ; "$" | ","

1056 (defvar yahtml-unreserved-chars-regexp

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

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

1059 Not used yet.")

1060

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

1062 "Translate reserved chars to URL encoded string."

1063 (let ((p 0) (target "")

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

1065 (cond

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

1067 (t

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

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

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

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

1072 (setq target (concat target

1073 (substring str 0 p)

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

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

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

1077 (concat target str)))))

1078

1079 (defun yahtml-unescape-string (str)

1080 "Untranslate reserved URL-encoded string."

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

1082 (unwind-protect

1083 (progn

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

1085 (setq target (concat target

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

1087 p (match-end 0)

1088 c (YaTeX-hex (substring

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

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

1091 (concat target (substring str p)))

1092 (store-match-data md))))

1093

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

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

1096 (interactive "r")

1097 (save-excursion

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

1099 (goto-char beg)

1100 (while (and (< (point) e)

1101 (re-search-forward

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

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

1104 (sit-for 0)

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

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

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

1108 ; (unwind-protect

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

1110 ; (save-excursion

1111 ; (backward-char 1)

1112 ; (delete-backward-char 4))

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

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

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

1116 (progn

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

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

1119 (set-marker e nil))))

1120 ;; ab%defgls/.|

1121

1122 (defun yahtml:a ()

1123 "Add-in function for <a>"

1124 (let ((href ""))

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

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

1127 href (yahtml-escape-chars-string

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

1129 (prog1

1130 (concat (yahtml-make-optional-argument

1131 "href" href)

1132 (yahtml-make-optional-argument

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

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

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

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

1137 (YaTeX-update-table

1138 (list href)

1139 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1140

1141 (defvar yahtml-parameters-completion-alist

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

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

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

1145 ("src" . file) ("file" . file)

1146 ("background" . file)

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

1148 ("method" ("POST") ("GET"))

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

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

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

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

1153 ("http-equiv" ("Refresh"))))

1154

1155 (defvar yahtml-link-types-alist

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

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

1158 ("subsection") ("appendix") ("help") ("bookmark")))

1159

1160 (defvar yahtml-content-types-alist

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

1162 ("text/sgml") ("text/xml")

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

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

1165 ("application/java")

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

1167 "Alist of content-types")

1168

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

1170 (let* ((alist

1171 (cdr-safe (assoc (downcase par)

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

1173 (prompt (concat par ": "))

1174 v)

1175 (cond

1176 ((eq alist 'file)

1177 (let ((insert-default-directory))

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

1179 ((eq alist 'command)

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

1181 (read-shell-command prompt)

1182 (read-string prompt)))

1183 ((and alist (symbolp alist))

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

1185 (alist

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

1187 (t

1188 (read-string prompt default)))))

1189

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

1191 "Make optional argument string."

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

1193 ""

1194 (concat " "

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

1196 "=\"" arg "\"")))

1197

1198 (defun yahtml:html ()

1199 "Add-in for <html>"

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

1201 (yahtml-make-optional-argument

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

1203

1204 (defun yahtml:head ()

1205 "Add-in for <head>"

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

1207 "")

1208

1209 (defun yahtml:body ()

1210 "Add-in function for <body>"

1211 (cond

1212 (yahtml-html4-strict nil)

1213 (t

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

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

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

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

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

1219 (concat

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

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

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

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

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

1225

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

1227 "Make CSS property definitions in style attribute."

1228 (mapconcat

1229 (function (lambda (x) (if (and (cdr x) (string< "" (cdr x)))

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

1231 (delq nil proplist)

1232 " "))

1233

1234 (defun yahtml:img ()

1235 "Add-in function for <img>"

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

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

1238 alt

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

1240 (l yahtml-prefer-upcase-attributes)

1241 info width height bytes comments)

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

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

1244 (car info)

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

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

1247 bytes (car (cdr (cdr info)))

1248 comments (nth 4 info)))

1249 (if info

1250 (setq alt

1251 (YaTeX-replace-formats

1252 yahtml:img-default-alt-format

1253 (list (cons "x" width)

1254 (cons "y" height)

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

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

1257 (cons "c" (car comments))))))

1258

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

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

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

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

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

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

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

1266 (if yahtml-html4-strict

1267 (yahtml-make-optional-argument

1268 "style"

1269 (if (or brd alg)

1270 (yahtml-make-style-parameter

1271 (list

1272 (if (string< "" alg)

1273 (cons "align" alg))

1274 (if (string< "" brd)

1275 (cons "border"

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

1277 (concat

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

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

1280

1281 (defun yahtml-file-truename (file)

1282 (cond

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

1284 (t (let ((new file))

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

1286 (not (equal new file)))

1287 (setq file new))

1288 file))))

1289

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

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

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

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

1294 (let ((mlt 1)

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

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

1297 (value 0))

1298 (while (> length 0)

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

1300 pos (+ pos direc)

1301 mlt (* mlt 256)

1302 length (1- length)))

1303 value))

1304

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

1306 "Return the information on the image file FILE.

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

1308 (save-excursion

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

1310 width height bytes depth comment

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

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

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

1314 (seekpoint 1)

1315 c1 c2 c3 c4 beg end

1316 (case-fold-search nil))

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

1318 (set-buffer tmpbuf)

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

1320 (erase-buffer)

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

1322 (unwind-protect

1323 (progn

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

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

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

1327 (YaTeX-insert-file-contents

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

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

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

1331 c2 (char-after 2)

1332 c3 (char-after 3)

1333 c4 (char-after 4))

1334 (cond

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

1336 ;;JPEG images need JPEG markers inspection

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

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

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

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

1341 (catch 'exit

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

1343 (cond

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

1345 ;maybe corrupted, exit from loop

1346 (throw 'exit t))

1347 ((memq

1348 (char-after (1+ seekpoint))

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

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

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

1352 ;;found!

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

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

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

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

1357 ;; JPEG comment area

1358 (setq beg (+ seekpoint 2 2)

1359 end (+ seekpoint

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

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

1362 (t ;other markers

1363 nil)) ;just skip it

1364 (setq seekpoint (+ seekpoint 2)

1365 seekpoint (+ seekpoint

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

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

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

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

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

1371 height (yahtml-hex-value 20 4)

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

1373 ((looking-at "GIF8")

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

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

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

1377 ((looking-at "BM")

1378 ;;# OS/2, Windoze BMP files

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

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

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

1382 (cond

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

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

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

1386 (t

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

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

1389 (message "")

1390 (kill-buffer tmpbuf))

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

1392

1393 (defun yahtml:form ()

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

1395 (concat

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

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

1398 "\""

1399 (yahtml-make-optional-argument

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

1401 (completing-read

1402 "Enctype: "

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

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

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

1406

1407 (defun yahtml:select ()

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

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

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

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

1412

1413 (defun yahtml:ol ()

1414 "Add-in function for <ol>"

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

1416 (let ((start (YaTeX-read-string-or-skip "start="))

1417 (type (YaTeX-completing-read-or-skip

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

1419 (concat

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

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

1422 (defun yahtml:ul ()

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

1424 (defun yahtml:dl ()

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

1426 (defun yahtml:dt ()

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

1428

1429 (defun yahtml:p ()

1430 (if yahtml-html4-strict nil

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

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

1433

1434 (defvar yahtml-input-types

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

1436 ("reset") ("image") ("hidden") ("file")))

1437

1438 (defun yahtml:input ()

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

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

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

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

1443 type (YaTeX-completing-read-or-skip "type (default=text): "

1444 yahtml-input-types nil t)

1445 value (YaTeX-read-string-or-skip "value: "))

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

1447 (setq size (YaTeX-read-string-or-skip "size: ")

1448 maxlength (YaTeX-read-string-or-skip "maxlength: ")))

1449 (concat

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

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

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

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

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

1455

1456 (defun yahtml:textarea ()

1457 "Add-in function for `textarea'"

1458 (interactive)

1459 (let (name rows cols)

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

1461 cols (read-string "Columns: ")

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

1463 (concat

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

1465 "\"" name "\"")

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

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

1468

1469 (defun yahtml:table ()

1470 "Add-in function for `table'"

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

1472 (a (yahtml-read-parameter

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

1474 (if yahtml-html4-strict

1475 (yahtml-make-optional-argument

1476 "style"

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

1478 (yahtml-make-style-parameter

1479 (append

1480 (if (string< "" b)

1481 (list

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

1483 (cons "border-collapse" "collapse")))

1484 (if (string< "" a)

1485 (cond

1486 ((string-match "right" a)

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

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

1489 ((string-match "center" a)

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

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

1492 (concat

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

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

1495

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

1497 (defun yahtml:caption ()

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

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

1500 (if yahtml-html4-strict

1501 (yahtml-make-optional-argument

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

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

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

1505

1506 (defun yahtml:font ()

1507 "Add-in function for `font'"

1508 (concat

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

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

1511

1512 (defun yahtml:style ()

1513 "Add-in function for `style'"

1514 (yahtml-make-optional-argument

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

1516

1517 (defun yahtml:script ()

1518 "Add-in function for `script'"

1519 (concat

1520 (yahtml-make-optional-argument

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

1522 (yahtml-make-optional-argument

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

1524

1525 (defun yahtml:tr ()

1526 "Add-in function for `tr'"

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

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

1529 "")

1530

1531 (defun yahtml:link ()

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

1533 (let (rel rev type href)

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

1535 (cond

1536 ((equal rel "")

1537 (concat (yahtml-make-optional-argument

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

1539 (yahtml-make-optional-argument

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

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

1542 )))

1543 ((string-match "stylesheet" rel)

1544 (concat

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

1546 (yahtml-make-optional-argument

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

1548 (progn

1549 (setq href

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

1551 (if (string< "" href)

1552 (progn

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

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

1555 (setq yahtml-css-class-alist

1556 (yahtml-css-collect-classes-file

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

1558 (message "")

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

1560 (t

1561 (concat

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

1563 (yahtml-make-optional-argument

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

1565 (yahtml-make-optional-argument

1566 "href"

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

1568

1569 (defvar yahtml:meta-names

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

1571

1572 (defun yahtml:meta ()

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

1574 "name"

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

1576 http-equiv content)

1577 (if (string= "" name)

1578 (if (string-match

1579 "Content-type"

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

1581 "http-equiv"

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

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

1584 "See docs/qanda")

1585 (concat http-equiv

1586 (yahtml-make-optional-argument

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

1588 (concat

1589 name

1590 (yahtml-make-optional-argument

1591 "content"

1592 (cond

1593 ((string-match "date" name)

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

1595 ((string-match "author" name)

1596 (read-string "Author: "

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

1598 (user-full-name)

1599 (user-login-name))))

1600 ((string-match "GENERATOR" name)

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

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

1603 (message "Thank you!"))

1604 content)

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

1606

1607 (defun yahtml:br ()

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

1609

1610 (defun yahtml:object ()

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

1612 data classid)

1613 (cond

1614 ((string-match "java" codetype)

1615 (let ((completion-ignored-extensions

1616 ;;any extensions except ".class"

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

1618 (setq classid (concat "java:"

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

1620 (concat

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

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

1623 (yahtml-make-optional-argument

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

1625 (yahtml-make-optional-argument

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

1627 (yahtml-make-optional-argument

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

1629 (t

1630 ""))))

1631

1632 (defun yahtml:abbr ()

1633 "Add-in function for abbr."

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

1635

1636 (defun yahtml:button ()

1637 (concat

1638 (yahtml-make-optional-argument

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

1640 (yahtml-make-optional-argument

1641 "type" (yahtml-read-parameter

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

1643 (yahtml-make-optional-argument

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

1645

1646 ;;; ---------- Simple tag ----------

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

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

1649 (interactive "P")

1650 (setq yahtml-current-completion-type 'inline

1651 region-mode (or region-mode (YaTeX-region-active-p)))

1652 (or tag

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

1654 (setq tag

1655 (YaTeX-cplread-with-learning

1656 (format "Tag %s(default %s): "

1657 (if region-mode "region: " "") yahtml-last-typeface-cmd)

1658 'yahtml-typeface-table 'yahtml-user-typeface-table

1659 'yahtml-tmp-typeface-table))))

1660 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))

1661 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))

1662 (setq yahtml-last-typeface-cmd tag

1663 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))

1664 (if region-mode

1665 (if (if (string< "19" emacs-version) (mark t) (mark))

1666 (save-excursion

1667 (if (> (point) (mark)) (exchange-point-and-mark))

1668 (insert (format "<%s%s>" tag (yahtml-addin tag)))

1669 (exchange-point-and-mark)

1670 (insert "</" tag ">"))

1671 (message "No mark set now"))

1672 (insert (format "<%s%s>" tag (yahtml-addin tag)))

1673 (save-excursion (insert (format "</%s>" tag)))))

1674

1675 (defun yahtml-insert-tag-region (&optional tag)

1676 "Call yahtml-insert-tag with region mode."

1677 (interactive)

1678 (yahtml-insert-tag t tag))

1679

1680 (defvar yahtml-need-single-closer nil) ;for test

1681 (defun yahtml-insert-single (cmd)

1682 "Insert <CMD>."

1683 (interactive

1684 (list

1685 (let ((completion-ignore-case t))

1686 (YaTeX-cplread-with-learning

1687 (format "Command%s: "

1688 (if yahtml-last-single-cmd

1689 (concat "(default " yahtml-last-single-cmd ")") ""))

1690 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

1691 'yahtml-tmp-single-cmd-table))))

1692 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))

1693 (setq yahtml-last-single-cmd

1694 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))

1695 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)

1696 yahtml-last-single-cmd))

1697 (insert (format "<%s%s%s>"

1698 cmd

1699 (yahtml-addin cmd)

1700 (if (and yahtml-need-single-closer

1701 (assoc cmd '(("br")("hr"))))

1702 " /" "")))

1703 (if (assoc cmd yahtml-env-table)

1704 (save-excursion (insert (format "</%s>" cmd)))))

1705

1706 (defun yahtml-insert-p (&optional arg)

1707 "Convenient function to insert <p></p>"

1708 (interactive "P")

1709 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")

1710 (yahtml-insert-single "p")))

1711

1712 (defun yahtml-insert-amps (arg)

1713 "Insert char-entity references via ampersand"

1714 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/

1715 (interactive "P")

1716 (let*((mess "") c

1717 (list (append yahtml-entity-reference-chars-alist-default

1718 yahtml-entity-reference-chars-alist))

1719 (l list))

1720 (while l

1721 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))

1722 l (cdr l)))

1723 (message "Char-entity reference: %s SPC=& RET=&; BS=%s Other=&#..;"

1724 mess (if YaTeX-japan "直前の文字" "Preceding-Char"))

1725 (setq c (read-char))

1726 (cond

1727 ((equal c (car-safe (assoc c list)))

1728 (insert (format "&%s;" (cdr (assoc c list)))))

1729 ((or (equal c ?\n) (equal c ?\r))

1730 (insert "&;")

1731 (forward-char -1))

1732 ((equal c ? )

1733 (insert ?&))

1734 ((and (memq c '(127 8))

1735 (setq c (preceding-char))

1736 (delete-backward-char 1)

1737 nil)) ;Fall through to the next 't block

1738 (t (insert (format "&#x%x;" c))))))

1739

1740 (defun yahtml:!--\#include ()

1741 (let ((file (yahtml-read-parameter "file" "")))

1742 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1743

1744 (defun yahtml:!--\#exec ()

1745 (format "cmd=\"%s\"--"

1746 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))

1747

1748 ;;; ---------- Jump ----------

1749 (defun yahtml-on-href-p ()

1750 "Check if point is on href clause."

1751 (let ((p (point)) e cmd (case-fold-search t))

1752 (save-excursion

1753 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした

1754 (save-excursion

1755 ;;(search-forward "</a>" nil t) ;aでなくても許可にした

1756 (search-forward "[\" \t\n]" nil t)

1757 (setq e (point)))

1758 ;(goto-char (get 'YaTeX-inner-environment 'point))

1759 (re-search-backward "<\$a\\|link\$\\>" nil t)

1760 (search-forward "href" e t)

1761 (search-forward "=" e t)

1762 (progn

1763 (skip-chars-forward " \t\n")

1764 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

1765 (< p (match-end 0))

1766 (yahtml-unescape-string (YaTeX-match-string 1))))))

1767

1768 (defun yahtml-netscape-sentinel (proc mes)

1769 (cond

1770 ((null (buffer-name (process-buffer proc)))

1771 (set-process-buffer proc nil))

1772 ((eq (process-status proc) 'exit)

1773 (let ((cb (current-buffer)))

1774 (set-buffer (process-buffer proc))

1775 (goto-char (point-min))

1776 (if (search-forward "not running" nil t)

1777 (progn

1778 (message "Starting netscape...")

1779 (start-process

1780 "browser" (process-buffer proc)

1781 shell-file-name yahtml-shell-command-option

1782 (format "%s \"%s\"" yahtml-www-browser

1783 (get 'yahtml-netscape-sentinel 'url)))

1784 (message "Starting netscape...Done")))

1785 (set-buffer cb)))))

1786

1787 (defvar yahtml-browser-process nil)

1788

1789 (defun yahtml-browse-html (href)

1790 "Call WWW Browser to see HREF."

1791 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1792 (cond

1793 ((string-match "^start\\>" yahtml-www-browser)

1794 (if (get-buffer pb)

1795 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1796 (put 'yahtml-netscape-sentinel 'url href)

1797 (set-process-sentinel

1798 (setq yahtml-browser-process

1799 (start-process

1800 "browser" pb shell-file-name yahtml-shell-command-option

1801 (format "%s \"%s\"" yahtml-www-browser href)))

1802 'yahtml-netscape-sentinel))

1803 ((and (string-match

1804 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

1805 (not (eq system-type 'windows-nt)))

1806 (if (get-buffer pb)

1807 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1808 (put 'yahtml-netscape-sentinel 'url href)

1809 (set-process-sentinel

1810 (setq yahtml-browser-process

1811 (start-process

1812 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1813 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1814 'yahtml-netscape-sentinel))

1815 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1816 (w3-fetch href))

1817 ((stringp yahtml-www-browser)

1818 (if (and yahtml-browser-process

1819 (eq (process-status yahtml-browser-process) 'run))

1820 (message "%s is already running" yahtml-www-browser)

1821 (setq yahtml-browser-process

1822 (start-process

1823 "browser" "* WWW Browser *"

1824 shell-file-name yahtml-shell-command-option

1825 (format "%s \"%s\"" yahtml-www-browser href)))))

1826 (t

1827 (message "Sorry, jump across http is not supported.")))))

1828

1829 (defun yahtml-goto-corresponding-href (&optional other)

1830 "Go to corresponding name."

1831 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1832 (if href

1833 (cond

1834 ((string-match "^\$ht\\|f\$tps?:" href)

1835 (yahtml-browse-html href))

1836 (t (setq file (substring href 0 (string-match "#" href)))

1837 (if (string-match "#" href)

1838 (setq name (substring href (1+ (string-match "#" href)))))

1839 (if (string< "" file)

1840 (progn

1841 (if (string-match "/$" file)

1842 (or (catch 'dirindex

1843 (mapcar

1844 (function

1845 (lambda (f)

1846 (if (file-exists-p (concat file f))

1847 (throw 'dirindex

1848 (setq file (concat file f))))))

1849 (yahtml-get-directory-index))

1850 nil)

1851 (setq file (concat file yahtml-directory-index))))

1852 (if (string-match "^/" file)

1853 (setq file (yahtml-url-to-path file)))

1854 (if other (YaTeX-switch-to-buffer-other-window file)

1855 (YaTeX-switch-to-buffer file))

1856 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1857 (if name

1858 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1859 t)))))

1860

1861 (defun yahtml-jump-to-name (name)

1862 "Jump to html's named tag."

1863 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1864 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1865 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1866 (message "Named tag `%s' not found" (substring href 1))))

1867

1868 (defun yahtml-on-begend-p (&optional p)

1869 "Check if point is on begend clause."

1870 (let ((p (or p (point))) cmd (case-fold-search t))

1871 (save-excursion

1872 (goto-char p)

1873 (if (equal (char-after (point)) ?<) (forward-char 1))

1874 (if (and (re-search-backward "<" nil t)

1875 (looking-at

1876 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1877 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1878 (condition-case nil

1879 (forward-list 1)

1880 (error nil))

1881 (< p (point)))

1882 (YaTeX-match-string 1)))))

1883

1884 (defun yahtml-goto-corresponding-begend (&optional noerr)

1885 "Go to corresponding opening/closing tag.

1886 Optional argument NOERR causes no error for unballanced tag."

1887 (let ((cmd (yahtml-on-begend-p)) m0

1888 (p (point)) (case-fold-search t) func str (nest 0))

1889 (cond

1890 (cmd

1891 (setq m0 (match-beginning 0))

1892 (if (= (aref cmd 0) ?/) ;on </cmd> line

1893 (setq cmd (substring cmd 1)

1894 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1895 func 're-search-backward)

1896 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1897 func 're-search-forward))

1898 (while (and (>= nest 0) (funcall func str nil t))

1899 (if (equal m0 (match-beginning 0))

1900 nil

1901 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1902 (if (< nest 0)

1903 (goto-char (match-beginning 0))

1904 (funcall

1905 (if noerr 'message 'error)

1906 "Corresponding tag of `%s' not found." cmd)

1907 (goto-char p)

1908 nil))

1909 (t nil))))

1910

1911 (defun yahtml-current-tag ()

1912 "Return the current tag name including #exec and #include."

1913 (save-excursion

1914 (let ((p (point)) b tag)

1915 (or (bobp)

1916 (looking-at "<")

1917 (progn (skip-chars-backward "^<") (forward-char -1)))

1918 (setq b (point))

1919 (skip-chars-forward "<")

1920 (setq tag (YaTeX-buffer-substring

1921 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1922 (goto-char b)

1923 (forward-list 1)

1924 (and (< p (point)) tag))))

1925

1926 (defun yahtml-get-attrvalue (attr)

1927 "Extract current tag's attribute value from buffer."

1928 (let (e (case-fold-search t))

1929 (save-excursion

1930 (or (looking-at "<")

1931 (progn (skip-chars-backward "^<") (backward-char 1)))

1932 (setq e (save-excursion (forward-list 1) (point)))

1933 (if (and

1934 (re-search-forward (concat "\\b" attr "\\b") e t)

1935 (progn (skip-chars-forward " \t\n=")

1936 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1937 (YaTeX-match-string 1)))))

1938

1939 (defun yahtml-goto-corresponding-img ()

1940 "View image on point"

1941 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1942 (if (and tag

1943 (string-match "img" tag)

1944 (setq image

1945 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1946 (progn

1947 (message "Invoking %s %s..." yahtml-image-viewer image)

1948 (start-process

1949 "Viewer" " * Image Viewer *"

1950 shell-file-name yahtml-shell-command-option ;"-c"

1951 (concat yahtml-image-viewer " " image))

1952 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1953

1954 (defun yahtml-goto-corresponding-source (&optional other)

1955 "Goto applet's or script's source."

1956 (let ((env (yahtml-current-tag)) s (p (point)))

1957 (cond

1958 ((string-match "applet" env)

1959 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1960 (progn

1961 (setq s (YaTeX-match-string 1)

1962 s (concat

1963 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1964 ".java"))

1965 (if other (YaTeX-switch-to-buffer-other-window s)

1966 (YaTeX-switch-to-buffer s))

1967 s) ;return source file name

1968 (message "No applet source specified")

1969 (sit-for 1)

1970 nil))

1971 ((string-match "script" env)

1972 (if (setq s (yahtml-get-attrvalue "src"))

1973 (progn

1974 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1975 'YaTeX-switch-to-buffer)

1976 (yahtml-url-to-path s))

1977 s)))

1978 ((string-match "!--#include" env)

1979 (cond

1980 ((setq s (yahtml-get-attrvalue "file")) ;

1981 (if other (YaTeX-switch-to-buffer-other-window s)

1982 (YaTeX-switch-to-buffer s))

1983 s)

1984 ((setq s (yahtml-get-attrvalue "virtual"));

1985 (setq s (yahtml-url-to-path s))

1986 (if other (YaTeX-switch-to-buffer-other-window s)

1987 (YaTeX-switch-to-buffer s))

1988 s)))

1989 ((and (string-match "!--#exec" env)

1990 (setq s (yahtml-get-attrvalue "cmd")))

1991 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1992 (let ((b " *yahtmltmp*")) ;peek a little

1993 (unwind-protect

1994 (progn

1995 (set-buffer (get-buffer-create b))

1996 (YaTeX-insert-file-contents s nil 0 100)

1997 (if (looking-at "#!")

1998 (if other (YaTeX-switch-to-buffer-other-window s)

1999 (YaTeX-switch-to-buffer s))))

2000 (kill-buffer (get-buffer b)))

2001 (get-file-buffer s))))))

2002

2003 (defun yahtml-goto-corresponding-* (&optional other)

2004 "Go to corresponding object."

2005 (interactive "P")

2006 (cond

2007 ((yahtml-goto-corresponding-href other))

2008 ((yahtml-goto-corresponding-img))

2009 ((yahtml-goto-corresponding-source other))

2010 ((yahtml-goto-corresponding-begend))

2011 (t (message "I don't know where to go."))))

2012

2013 (defun yahtml-goto-corresponding-*-other-window ()

2014 "Go to corresponding object."

2015 (interactive)

2016 (yahtml-goto-corresponding-* t))

2017

2018 (defun yahtml-visit-main ()

2019 "Go to parent file from where you visit current file."

2020 (interactive)

2021 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2022

2023 ;;; ---------- killing ----------

2024 (defun yahtml-kill-begend (&optional whole)

2025 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2026 (if tag

2027 (save-excursion

2028 (or (looking-at "<")

2029 (progn (skip-chars-backward "^<") (forward-char -1)))

2030 (setq p (point))

2031 (yahtml-goto-corresponding-begend)

2032 (or (looking-at "<")

2033 (progn (skip-chars-backward "^<") (forward-char -1)))

2034 (if (< (point) p) ;if on the opening tag

2035 (progn (setq q p p (point))

2036 (goto-char q))

2037 (setq q (point))) ;now q has end-line's (point)

2038 (if (not whole)

2039 (kill-region

2040 (progn (skip-chars-backward " \t")

2041 (if (setq bbolp (bolp)) (point) q))

2042 (progn (forward-list 1)

2043 (setq r (point))

2044 (skip-chars-forward " \t")

2045 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2046 (goto-char p)

2047 (skip-chars-backward " \t")

2048 (if (not whole)

2049 (progn

2050 (kill-append

2051 (buffer-substring

2052 (setq p (if (setq bbolp (bolp)) (point) p))

2053 (setq q (progn

2054 (forward-list 1)

2055 (setq r (point))

2056 (skip-chars-forward " \t")

2057 (if (and bbolp (eolp) (not (eobp)))

2058 (1+ (point))

2059 r))))

2060 t)

2061 (delete-region p q))

2062 (kill-region

2063 (if (bolp) (point) p)

2064 (progn (goto-char q)

2065 (forward-list 1)

2066 (setq r (point))

2067 (skip-chars-forward " \t")

2068 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2069 tag))))

2070

2071 (defun yahtml-kill-* (whole)

2072 "Kill current position's HTML tag (set)."

2073 (interactive "P")

2074 (cond

2075 ((yahtml-kill-begend whole))))

2076

2077

2078 ;;; ---------- changing ----------

2079 (defun yahtml-on-assignment-p ()

2080 "Return if current point is on parameter assignment.

2081 If so, return parameter name, otherwise nil.

2082 This function should be able to treat white spaces in value, but not yet."

2083 (let ((p (point)))

2084 (save-excursion

2085 (put 'yahtml-on-assignment-p 'region nil)

2086 (skip-chars-backward "^ \t\n")

2087 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2088 (< p (match-end 0))

2089 (>= p (1- (match-beginning 2)))

2090 (put 'yahtml-on-assignment-p 'region

2091 (cons (match-beginning 2) (match-end 2)))

2092 (YaTeX-match-string 1)))))

2093

2094 (defun yahtml-change-begend ()

2095 (let ((tag (yahtml-on-begend-p))

2096 (completion-ignore-case t)

2097 (case-fold-search t)

2098 (p (point)) (q (make-marker))

2099 (default (append yahtml-env-table yahtml-typeface-table))

2100 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2101 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2102 href b1 e1 attr new css)

2103 (cond

2104 (tag

2105 (cond

2106 ((and (string-match "^a$" tag)

2107 (save-excursion

2108 (and

2109 (re-search-backward "<a\\b" nil t)

2110 (progn

2111 (goto-char (match-end 0))

2112 (skip-chars-forward " \t\n")

2113 (setq b1 (point))

2114 (search-forward ">" nil t))

2115 (setq e1 (match-beginning 0))

2116 (goto-char b1)

2117 (re-search-forward "href\\s *=" e1 t)

2118 (>= p (point))

2119 (progn

2120 (goto-char (match-end 0))

2121 (skip-chars-forward " \t\n")

2122 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2123 (< p (match-end 0)))))

2124 (setq b1 (match-beginning 1) e1 (match-end 1)

2125 yahtml-completing-buffer (current-buffer)

2126 ;; yahtml-urls-local is buffer-local, so we must put

2127 ;; that into yahtml-urls here

2128 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2129 href (read-from-minibuffer

2130 "Change href to: " "" yahtml-url-completion-map))

2131 (if (string< "" href)

2132 (progn

2133 ;;(setq href ;??

2134 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2135 (delete-region b1 e1)

2136 (goto-char b1)

2137 (insert href))))

2138 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2139 (if (and (equal attr "class") ;treat "class" attribute specially

2140 (setq css (yahtml-css-get-element-completion-alist tag)))

2141

2142 (setq new (yahtml-read-css css))

2143 ;;other than "class", read parameter normally

2144 (setq new (yahtml-read-parameter attr)))

2145 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2146 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2147 (insert new))

2148 (t

2149 (save-excursion

2150 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2151 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2152 (skip-chars-forward "^A-Za-z")

2153 (set-marker q (point))

2154 (setq p (point))

2155 (yahtml-goto-corresponding-begend)

2156 (or (= (char-after (point)) ?<)

2157 (skip-chars-backward "^<"))

2158 (skip-chars-forward "^A-Za-z")

2159 (if (= (char-after (1- (point))) ?/)

2160 (progn

2161 (set-marker q (point))

2162 (goto-char p)))

2163 (setq tag (let ((completion-ignore-case t))

2164 (YaTeX-cplread-with-learning

2165 (format "Change `%s' to(default %s): "

2166 tag yahtml-last-begend)

2167 'default 'user 'tmp)))

2168 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2169 (if (string= "" tag) (setq tag yahtml-last-begend))

2170 (setq yahtml-last-begend

2171 (or (cdr (assoc tag yahtml-env-table)) tag)

2172 tag yahtml-last-begend)

2173 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2174 (insert (format "%s%s" tag (yahtml-addin tag)))

2175 (goto-char q)

2176 (set-marker q nil)

2177 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2178 (insert tag))))

2179 t))))

2180

2181 (defun yahtml-change-command ()

2182 (let ((p (point)) (case-fold-search t) cmd par new

2183 (beg (make-marker)) (end (make-marker)))

2184 (skip-chars-backward "^<")

2185 (if (and

2186 (looking-at yahtml-command-regexp)

2187 (progn

2188 (set-marker beg (match-beginning 0))

2189 (set-marker end (match-end 0))

2190 t) ;for further work

2191 (progn

2192 (forward-char -1)

2193 (condition-case nil

2194 (forward-list 1)

2195 (error nil))

2196 (< p (point))))

2197 (progn

2198 (goto-char p)

2199 (if (setq par (yahtml-on-assignment-p))

2200 (progn

2201 (setq new (yahtml-read-parameter par))

2202 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2203 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2204 (setq new

2205 (YaTeX-cplread-with-learning

2206 "Change form to: "

2207 'yahtml-form-table 'yahtml-user-form-table

2208 'yahtml-tmp-form-table)))

2209 (delete-region beg end)

2210 (goto-char beg)

2211 (set-marker beg nil)

2212 (set-marker end nil)

2213 (insert new)

2214 t)

2215 (goto-char p)

2216 nil)))

2217

2218 (defun yahtml-change-* ()

2219 "Change current position's HTML tag (set)."

2220 (interactive)

2221 (cond

2222 ((yahtml-change-begend))

2223 ((yahtml-change-command))))

2224

2225 ;;; ---------- commenting ----------

2226

2227 (defun yahtml-comment-region (&optional uncom)

2228 "Comment out region or environment."

2229 (interactive)

2230 (let ((e (make-marker)) be beg p)

2231 (cond

2232 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2233 (setq be (yahtml-on-begend-p))

2234 (save-excursion

2235 (setq p (point))

2236 (if (string-match "^/" be)

2237 (setq beg (progn (forward-line 1) (point)))

2238 (setq beg (progn (beginning-of-line) (point))))

2239 (goto-char p)

2240 (yahtml-goto-corresponding-begend)

2241 (if (string-match "^/" be)

2242 (beginning-of-line)

2243 (forward-line 1))

2244 (set-marker e (point))

2245 ;(comment-region beg (point) (if uncom (list 4)))))

2246 ))

2247 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2248 (setq beg (region-beginning))

2249 (set-marker e (region-end))))

2250 (if yahtml-translate-hyphens-when-comment-region

2251 (let ((yahtml-entity-reference-chars-alist-default nil)

2252 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2253 yahtml-entity-reference-chars-regexp

2254 yahtml-entity-reference-chars-reverse-regexp)

2255 (yahtml-entity-reference-chars-setup)

2256 (funcall

2257 (if uncom 'yahtml-translate-reverse-region

2258 'yahtml-translate-region)

2259 beg e)))

2260 (comment-region beg e (if uncom (list 4)))

2261 (set-marker e nil)))

2262

2263 (defun yahtml-uncomment-region ()

2264 (interactive)

2265 (yahtml-comment-region t))

2266

2267 ;;; ---------- translate to entity references ----------

2268 (defvar yahtml-entity-reference-chars-alist-default

2269 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2270 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2271 "Default translation table from character to entity reference")

2272 (defvar yahtml-entity-reference-chars-alist nil

2273 "*Translation table from character to entity reference")

2274 (defvar yahtml-entity-reference-chars-regexp nil)

2275 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2276

2277 (defun yahtml-entity-reference-chars-setup ()

2278 (let ((list (append yahtml-entity-reference-chars-alist-default

2279 yahtml-entity-reference-chars-alist)))

2280 (setq yahtml-entity-reference-chars-regexp "["

2281 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2282 (while list

2283 (setq yahtml-entity-reference-chars-regexp

2284 (concat yahtml-entity-reference-chars-regexp

2285 (char-to-string (car (car list))))

2286 yahtml-entity-reference-chars-reverse-regexp

2287 (concat yahtml-entity-reference-chars-reverse-regexp

2288 (cdr (car list))

2289 (if (cdr list) "\\|")))

2290 (setq list (cdr list)))

2291 (setq yahtml-entity-reference-chars-regexp

2292 (concat yahtml-entity-reference-chars-regexp "]")

2293 yahtml-entity-reference-chars-reverse-regexp

2294 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2295

2296 (yahtml-entity-reference-chars-setup)

2297

2298 (defun yahtml-translate-region (beg end)

2299 "Translate inhibited literals."

2300 (interactive "r")

2301 (save-excursion

2302 (save-restriction

2303 (narrow-to-region beg end)

2304 (let ((ct (append yahtml-entity-reference-chars-alist

2305 yahtml-entity-reference-chars-alist-default)))

2306 (goto-char beg)

2307 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2308 ;(setq c (preceding-char))

2309 (replace-match

2310 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2311

2312 (defun yahtml-translate-reverse-region (beg end)

2313 "Translate entity references to literals."

2314 (interactive "r")

2315 (save-excursion

2316 (save-restriction

2317 (narrow-to-region beg end)

2318 (let ((ct (append yahtml-entity-reference-chars-alist

2319 yahtml-entity-reference-chars-alist-default))

2320 ec)

2321 (goto-char beg)

2322 (while (re-search-forward

2323 yahtml-entity-reference-chars-reverse-regexp nil t)

2324 ;(setq c (preceding-char))

2325 (setq ec (YaTeX-match-string 1))

2326 (delete-region (match-end 0) (match-beginning 0))

2327 (insert (car (YaTeX-rassoc ec ct))))))))

2328

2329 (defun yahtml-inner-environment-but (exclude &optional quick)

2330 "Return the inner environment but matches with EXCLUDE tag."

2331 (let (e (case-fold-search t))

2332 (save-excursion

2333 (while (and (setq e (YaTeX-inner-environment quick))

2334 (string-match exclude e))

2335 (goto-char (get 'YaTeX-inner-environment 'point))))

2336 e))

2337

2338 (defun yahtml-untranslate-string (str)

2339 "Untranslate entity reference."

2340 (let ((md (match-data)) (left "") (right str) b0 ch

2341 (ct (append yahtml-entity-reference-chars-alist

2342 yahtml-entity-reference-chars-alist-default))

2343 (revrex yahtml-entity-reference-chars-reverse-regexp))

2344 (unwind-protect

2345 (progn

2346 (while (string< "" right)

2347 (cond

2348 ((string-match revrex right)

2349 (setq ch (YaTeX-rassoc

2350 (substring right (match-beginning 1) (match-end 1)))

2351 b0 (substring right 0 (match-beginning 0))

2352 right (substring right (match-end 0))

2353 left (concat left

2354 (substring right 0 (match-beginning 0))

2355 (char-to-string ch))))

2356 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2357 (setq ch (substring right (match-beginning 2) (match-end 2))

2358 b0 (substring right 0 (match-beginning 0))

2359 right (substring right (match-end 0))

2360 left (concat left

2361 b0

2362 (char-to-string

2363 (if (match-beginning 1)

2364 (YaTeX-hex ch)

2365 (string-to-number ch))))))

2366 (t (setq left (concat left right)

2367 right ""))))

2368 left)

2369 (store-match-data md))))

2370

2371 ;;; ---------- table-ize region ----------

2372 (defun yahtml-td-region (e delim beg end)

2373 "Enclose each item in a region with <td>..</td>.

2374 Interactive prefix argument consults enclosing element other than td."

2375 (interactive "P\nsDelimiter(s): \nr")

2376 (let ((e (cond

2377 ((null e) "td")

2378 ((stringp e) e)

2379 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2380 (ws "[ \t]")

2381 elm p i)

2382 (if (string= delim "") (setq delim " \t\n"))

2383 (setq delim (concat "[" delim "]+")

2384 elm (if (string= "thd" e)

2385 (cons "th" "td")

2386 (cons e e)))

2387 (save-excursion

2388 (save-restriction

2389 (narrow-to-region beg end)

2390 (goto-char (setq p (point-min)))

2391 (setq i 0 e (car elm))

2392 (while (re-search-forward delim nil t)

2393 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2394 (goto-char (match-beginning 0))

2395 (insert "</" e ">")

2396 (save-excursion

2397 (goto-char p)

2398 (insert "<" e ">"))

2399 (setq p (point))

2400 (while (and (not (eobp)) (looking-at ws))

2401 (delete-char 1))

2402 (if (looking-at delim) (delete-char 1)))

2403 (insert "<" e ">")

2404 (goto-char (point-max))

2405 (insert "</" e ">")))))

2406

2407 (defun yahtml-tr-region (e delim beg end)

2408 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2409 (interactive "P\nsDelimiter(s): \nr")

2410 (setq e (if (and e (listp e))

2411 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2412 "th")))

2413 (save-excursion

2414 (save-restriction

2415 (narrow-to-region (point) (mark))

2416 (goto-char (point-min))

2417 (while (not (eobp))

2418 (insert "<tr>")

2419 (yahtml-td-region e delim (point) (point-end-of-line))

2420 (end-of-line)

2421 (insert "</tr>")

2422 (forward-line 1)))))

2423

2424 ;;; ---------- filling ----------

2425 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2426 (defun yahtml-move-to-column (col &optional force)

2427 (beginning-of-line)

2428 (let ((ccol 0))

2429 (while (and (> col ccol) (not (eolp)))

2430 (if (eq (following-char) ?\<)

2431 (progn

2432 (while (and (not (eq (following-char) ?\>))

2433 (not (eolp)))

2434 (forward-char))

2435 (or (eolp) (forward-char)))

2436 (or (eolp) (forward-char))

2437 (if (eq (preceding-char) ?\t)

2438 (let ((wd (- 8 (% (+ ccol 8) 8))))

2439 (if (and force (< col (+ ccol wd)))

2440 (progn

2441 (backward-char 1)

2442 (insert-char ?\ (- col ccol))

2443 (setq ccol col))

2444 (setq ccol (+ ccol wd))))

2445 (setq ccol (1+ ccol)))

2446 (if (and YaTeX-japan

2447 (or

2448 (and (fboundp 'char-category)

2449 (string-match "[chj]" (char-category (preceding-char))))

2450 (and (fboundp 'char-charset)

2451 (not (eq (char-charset (preceding-char)) 'ascii)))))

2452 (setq ccol (1+ ccol)))))

2453 (if (and force (> col ccol))

2454 (progn

2455 (insert-char ?\ (- col ccol))

2456 col)

2457 ccol)))

2458

2459 (defun yahtml-fill-paragraph (arg)

2460 (interactive "P")

2461 (let*((case-fold-search t) (p (point)) fill-prefix

2462 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2463 indent

2464 (startp (get 'YaTeX-inner-environment 'point))

2465 (prep (string-match "^pre$" e))

2466 (ps1 (if prep (default-value 'paragraph-start)

2467 paragraph-start))

2468 (ps2 (if prep (concat (default-value 'paragraph-start)

2469 "$\\|^\\s *</?pre>")

2470 paragraph-start)))

2471 (save-excursion

2472 (unwind-protect

2473 (progn

2474 (if prep

2475 (fset 'move-to-column 'yahtml-move-to-column))

2476 (save-excursion

2477 (beginning-of-line)

2478 (indent-to-column (yahtml-this-indent))

2479 (setq fill-prefix

2480 (buffer-substring (point) (point-beginning-of-line)))

2481 (delete-region (point) (point-beginning-of-line)))

2482 (fill-region-as-paragraph

2483 (progn (re-search-backward paragraph-start nil t)

2484 (or (save-excursion

2485 (goto-char (match-beginning 0))

2486 (if (looking-at "<")

2487 (forward-list)

2488 (goto-char (match-end 0))

2489 (skip-chars-forward " \t>"))

2490 (if (looking-at "[ \t]*$")

2491 (progn (forward-line 1) (point))))

2492 (point)))

2493 (progn (goto-char p)

2494 (re-search-forward ps2 nil t)

2495 (match-beginning 0))))

2496 (fset 'move-to-column yahtml-saved-move-to-column)))))

2497

2498 ;;;

2499 ;;; ---------- move forward/backward field ----------

2500 ;;;

2501 (defun yahtml-element-path ()

2502 "Return the element path from <body> at point as a list"

2503 (let (path elm)

2504 (save-excursion

2505 (while (and (YaTeX-beginning-of-environment)

2506 (looking-at (concat "<\$" yahtml-command-regexp "\$\\>"))

2507 (not (string= (setq elm (downcase (YaTeX-match-string 1)))

2508 "body")))

2509 (setq path (cons elm path)

2510 elm nil))

2511 (and elm (setq path (cons elm path))))))

2512

2513 (defun yahtml-forward-field (arg)

2514 "Move ARGth forward cell to table element.

2515 ENVINFO is a cons of target element name and its beginning point."

2516 (interactive "p")

2517 (let (inenv elm path sibs)

2518 (cond

2519 ((< arg 0) (yahtml-backward-field (- arg)))

2520 ((= arg 0) nil)

2521 ((and (setq path (nreverse (yahtml-element-path)))

2522 (catch 'sibling

2523 (while path

2524 (if (setq elm (car-safe

2525 (member (car path) '("td" "th" "li" "dt" "dd"))))

2526 (throw 'sibling elm))

2527 (setq path (cdr path)))))

2528 (setq inenv (YaTeX-in-environment-p elm)

2529 sibs (cdr (assoc elm '(("td" . "td\\|th")

2530 ("th" . "td\\|th")

2531 ("li" . "li")

2532 ("dt" . "dt\\|dd")

2533 ("dd" . "dt\\|dd")))))

2534 (goto-char (cdr inenv))

2535 (while (>= (setq arg (1- arg)) 0)

2536 (yahtml-goto-corresponding-begend)

2537 (if (looking-at "<") (forward-list 1))

2538 (skip-chars-forward "^<"))

2539 (while (looking-at "\\s \\|\$</\$")

2540 (if (match-beginning 1) (forward-list 1)

2541 (skip-chars-forward "\n\t ")))

2542 (forward-list 1) ;; step into environment

2543 (skip-chars-forward " \t\n")

2544 (if (looking-at (concat "<\$" sibs "\$\\>"))

2545 (forward-list 1))

2546 ))))

2547

2548

2549 ;;;

2550 ;;; ---------- indentation ----------

2551 ;;;

2552 (defun yahtml-indent-line-1 ()

2553 "Indent a line (faster wrapper)"

2554 (interactive)

2555 (let (indent)

2556 (if (and (save-excursion

2557 (beginning-of-line) (skip-chars-forward "\t ")

2558 (not (looking-at "<")))

2559 (save-excursion

2560 (forward-line -1)

2561 (while (and (not (bobp)) (looking-at "^\\s *$"))

2562 (forward-line -1))

2563 (skip-chars-forward "\t ")

2564 (setq indent (current-column))

2565 (not (looking-at "<"))))

2566 (progn

2567 (save-excursion

2568 (beginning-of-line)

2569 (skip-chars-forward " \t")

2570 (or (= (current-column) indent)

2571 (YaTeX-reindent indent)))

2572 (and (bolp) (skip-chars-forward " \t")))

2573 (yahtml-indent-line-real))))

2574

2575 (defun yahtml-indent-line ()

2576 "Indent a line (Second level wrapper).

2577 See also yahtml-indent-line-1 and yahtml-indent-line-real."

2578 (interactive)

2579 (let ((cc (current-column)) (p (point)))

2580 (yahtml-indent-line-1)

2581 (and (= cc (current-column))

2582 (= p (point))

2583 (equal last-command 'yahtml-indent-line)

2584 (yahtml-forward-field 1))))

2585

2586

2587 (defun yahtml-this-indent ()

2589 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2590 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2591 (excludes

2592 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2593 inenv p col peol (case-fold-search t))

2594 (save-excursion

2595 (beginning-of-line)

2596 (setq inenv (or (yahtml-inner-environment-but excludes t)

2597 "html")

2598 col (get 'YaTeX-inner-environment 'indent)

2599 p (get 'YaTeX-inner-environment 'point)

2600 op nil))

2601 (save-excursion

2602 (cond

2603 ((string-match (concat "^\$" envs "\$") inenv)

2604 (save-excursion

2605 (beginning-of-line)

2606 (skip-chars-forward " \t")

2607 (cond ;lookup current line's tag

2608 ((looking-at (concat "</\$" envs "\$>"))

2609 col)

2610 ((looking-at itms)

2611 (+ col yahtml-environment-indent))

2612 ((and yahtml-hate-too-deep-indentation

2613 (looking-at (concat "<\$" envs "\$")))

2614 (+ col (* 2 yahtml-environment-indent)))

2615 ((and (< p (point))

2616 (string-match itemizing-envs inenv)

2617 (save-excursion

2618 (and

2619 (setq op (point))

2620 (goto-char p)

2621 (re-search-forward itms op t)

2622 (progn

2623 (if yahtml-indent-listing-constant

2624 (setq col (+ (current-column)

2625 (if yahtml-faithful-to-htmllint 1 2)))

2626 (skip-chars-forward "^>")

2627 (skip-chars-forward ">")

2628 (skip-chars-forward " \t")

2629 (setq col (if (looking-at "$")

2630 (+ col yahtml-environment-indent)

2631 (current-column))))))))

2632 col)

2633 (t

2634 (+ col yahtml-environment-indent)))))

2635 (t col)))))

2636

2637 (defun yahtml-indent-line-real ()

2638 "Indent current line."

2639 (interactive)

2640 (YaTeX-reindent (yahtml-this-indent))

2641 (if (bolp) (skip-chars-forward " \t"))

2642 (let (peol col inenv)

2643 (if (and (setq inenv (yahtml-on-begend-p))

2644 (string-match

2645 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2646 (save-excursion

2647 (setq peol (point-end-of-line))

2648 (or (= (char-after (point)) ?<)

2649 (progn (skip-chars-backward "^<") (forward-char -1)))

2650 (setq col (current-column))

2651 (if (and (yahtml-goto-corresponding-begend t)

2652 (> (point) peol)) ;if on the different line

2653 (YaTeX-reindent col))))))

2654

2655 ;(defun yahtml-fill-item ()

2656 ; "Fill item HTML version"

2657 ; (interactive)

2658 ; (let (inenv p fill-prefix peol (case-fold-search t))

2659 ; (setq inenv (or (YaTeX-inner-environment) "html")

2660 ; p (get 'YaTeX-inner-environment 'point))

2661 ; (cond

2662 ; ((string-match "^[uod]l" inenv)

2663 ; (save-excursion

2664 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2665 ; (progn

2666 ; (goto-char (match-end 0))

2667 ; (setq col (current-column)))

2668 ; (error "No <li>, <dt>, <dd>")))

2669 ; (save-excursion

2670 ; (end-of-line)

2671 ; (setq peol (point))

2672 ; (newline)

2673 ; (indent-to-column col)

2674 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2675 ; (delete-region (point) peol)

2676 ; (fill-region-as-paragraph

2677 ; (progn (re-search-backward paragraph-start nil t) (point))

2678 ; (progn (re-search-forward paragraph-start nil t 2)

2679 ; (match-beginning 0)))))

2680 ; (t nil))))

2681

2682 ;;;

2683 ;;; ---------- Lint and Browsing ----------

2684 ;;;

2685 (defun yahtml-browse-menu ()

2686 "Browsing or other external process invokation menu."

2687 (interactive)

2688 (message "J)weblint p)Browse R)eload N)ewpage...")

2689 (let ((c (char-to-string (read-char))))

2690 (cond

2691 ((string-match "j" c)

2692 (yahtml-lint-buffer (current-buffer)))

2693 ((string-match "[bp]" c)

2694 (yahtml-browse-current-file))

2695 ((string-match "r" c)

2696 (yahtml-browse-reload))

2697 ((string-match "n" c)

2698 (call-interactively 'yahtml-newpage)))))

2699

2700 (if (fboundp 'wrap-function-to-control-ime)

2701 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2702

2703 (defvar yahtml-lint-buffer "*weblint*")

2704

2705 (defun yahtml-lint-buffer (buf)

2706 "Call lint on buffer BUF."

2707 (require 'yatexprc)

2708 (interactive "bCall lint on buffer: ")

2709 (setq buf (get-buffer buf))

2710 (YaTeX-save-buffers)

2711 (let ((bcmd (YaTeX-get-builtin "lint")))

2712 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2713 (YaTeX-typeset

2714 (concat (or bcmd yahtml-lint-program)

2715 " " (file-name-nondirectory (buffer-file-name buf)))

2716 yahtml-lint-buffer "lint" "lint")))

2717

2718 (defun yahtml-file-to-url (file)

2719 "Convert local unix file name to URL.

2720 If no matches found in yahtml-path-url-alist, return raw file name."

2721 (let ((list yahtml-path-url-alist) p url)

2722 (if (file-directory-p file)

2723 (setq file (expand-file-name yahtml-directory-index file))

2724 (setq file (expand-file-name file)))

2725 (if (string-match "^[A-Za-z]:/" file)

2726 (progn

2727 ;; (aset file 1 ?|) ;これは要らないらしい…

2728 (setq file (concat "///" file))))

2729 (while list

2730 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2731 (setq url (cdr (car list))

2732 file (substring file (match-end 0))

2733 url (concat url file)

2734 list nil))

2735 (setq list (cdr list)))

2736 (or url (concat "file:" file))))

2737

2738 (defun yahtml-url-to-path (file &optional basedir)

2739 "Convert local URL name to unix file name."

2740 (let ((list yahtml-path-url-alist) url realpath docroot

2741 (dirsufp (string-match "/$" file)))

2742 (setq basedir (or basedir

2743 (file-name-directory

2744 (expand-file-name default-directory))))

2745 (cond

2746 ((string-match "^/" file)

2747 (while list

2748 (if (file-directory-p (car (car list)))

2749 (progn

2750 (setq url (cdr (car list)))

2751 (if (string-match "\$http://[^/]*\$/" url)

2752 (setq docroot (substring url (match-end 1)))

2753 (setq docroot url))

2754 (cond

2755 ((string-match (concat "^" (regexp-quote docroot)) file)

2756 (setq realpath

2757 (expand-file-name

2758 (substring

2759 file

2760 (if (= (aref file (1- (match-end 0))) ?/)

2761 (match-end 0) ; "/foo"

2762 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2763 (car (car list))))))

2764 (if realpath

2765 (progn (setq list nil)

2766 (if (and dirsufp (not (string-match "/$" realpath)))

2767 (setq realpath (concat realpath "/")))))))

2768 (setq list (cdr list)))

2769 realpath)

2770 (t file))))

2771

2772 (defun yahtml-browse-current-file ()

2773 "Call WWW browser on current file."

2774 (interactive)

2775 (basic-save-buffer)

2776 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2777

2778 (defun yahtml-browse-reload ()

2779 "Send `reload' event to netscape."

2780 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2781 (cond

2782 ((string-match "[Nn]etscape" yahtml-www-browser)

2783 (if (get-buffer pb)

2784 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2785 ;;(or (get 'yahtml-netscape-sentinel 'url)

2786 ;; (error "Reload should be called after Browsing."))

2787 (put 'yahtml-netscape-sentinel 'url

2788 (yahtml-file-to-url (buffer-file-name)))

2789 (basic-save-buffer)

2790 (set-process-sentinel

2791 (setq yahtml-browser-process

2792 (start-process

2793 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2794 (format "%s -remote 'reload'" yahtml-www-browser)))

2795 'yahtml-netscape-sentinel))

2796 (t

2797 (message "Sorry, RELOAD is supported only for Netscape.")))))

2798

2799 ;;; ---------- Intelligent newline ----------

2800 (defun yahtml-intelligent-newline (arg)

2801 "Intelligent newline for HTML"

2802 (interactive "P")

2803 (let (env func)

2804 (end-of-line)

2805 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2806 "html")))

2807 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2808 (newline)

2809 (if (and env func (fboundp func))

2810 ;; if intelligent line function is defined, call that

2811 (funcall func)

2812 ;; else do the default action

2813 (if (string-match yahtml-p-prefered-env-regexp env)

2814 (yahtml-insert-p)))))

2815

2816 (defun yahtml-intelligent-newline-ul ()

2817 (interactive)

2818 (yahtml-insert-single "li")

2819 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2820 (yahtml-indent-line))

2821

2822 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2823

2824 (defun yahtml-intelligent-newline-dl ()

2825 (interactive)

2826 (let ((case-fold-search t))

2827 (if (save-excursion

2828 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2829 (get 'YaTeX-inner-environment 'point) t))

2830 (cond

2831 ((match-beginning 2)

2832 (yahtml-insert-single "dd")

2833 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2834 (setq yahtml-last-single-cmd "dt"))

2835 ((match-beginning 3)

2836 (yahtml-insert-single "dt")

2837 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2838 (setq yahtml-last-single-cmd "dd")))

2839 (yahtml-insert-single "dt")

2840 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2841 (setq yahtml-last-single-cmd "dd"))

2842 (yahtml-indent-line)

2843 (and (string-match yahtml-p-prefered-env-regexp "dl")

2844 (string-equal yahtml-last-single-cmd "dt")

2845 (yahtml-insert-p nil))))

2846

2847 (defun yahtml-intelligent-newline-select ()

2848 (interactive)

2849 (yahtml-insert-single (if yahtml-prefer-upcases "OPTION" "option"))

2850 (yahtml-indent-line))

2851

2852 (defun yahtml-intelligent-newline-style ()

2853 (interactive)

2854 (if (save-excursion

2855 (and

2856 (re-search-backward "<style\\|<!-- " nil t)

2857 (looking-at "<style")))

2858 (let (c)

2859 (yahtml-indent-line)

2860 (setq c (current-column))

2861 (insert "<!--\n")

2862 (YaTeX-reindent c)

2863 (insert "-->")

2864 (beginning-of-line)

2865 (open-line 1)

2866 (YaTeX-reindent c))))

2867

2868 (defun yahtml-intelligent-newline-head ()

2869 (let ((title (read-string "Document title: "))

2870 (b "<title>") (e "</title>") p)

2871 (yahtml-indent-line)

2872 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2873 (setq p (point))

2874 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2875 (if (string= "" title) (goto-char p))

2876 (setq yahtml-last-begend "body")))

2877

2878 (defun yahtml-intelligent-newline-script ()

2879 (let ((p (point)) b)

2880 (if (save-excursion

2881 (and

2882 (setq b (re-search-backward "<script\\>" nil t))

2883 (re-search-forward

2884 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2885 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2886 c (srcp (re-search-backward "src=" b t)))

2887 (goto-char p)

2888 (yahtml-indent-line)

2889 (setq c (current-column))

2890 (if srcp

2891 nil

2892 (insert "")

2893 (beginning-of-line)

2894 (open-line 1)

2895 (YaTeX-reindent c))))))

2896

2897 (defun yahtml-intelligent-newline-table ()

2898 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2899 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2900 (cond

2901 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2902 (while (and (setq rb (re-search-backward ptn tb t))

2903 (match-beginning 1))

2904 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2905 (goto-char (match-end 0))

2906 (skip-chars-forward " \t\n")

2907 (if (and (search-forward "colspan\\s *=" p t)

2908 (progn

2909 (skip-chars-forward "\"' \t\n")

2910 (looking-at "[0-9]+")))

2911 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2912 (setq cols (1+ cols)))

2913 (goto-char rb)

2914 (setq p (point)))

2915 (if (> cols 0)

2916 (message "%s columns found. %s"

2917 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2918 "New tr?(N) or Duplicate")))

2919 (cond

2920 ((and (> cols 0)

2921 (memq (read-char) '(?d ?D))) ;Duplication mode

2922 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2923 (t ;empty cells

2924 (setq line "<tr>" i 0)

2925 (if (> cols 0)

2926 (while (> cols i)

2927 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2928 "<td></td>"))

2929 th nil i (1+ i)))

2930 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2931 (while (string-match "t\$h\$\\|td" fmt i)

2932 (setq line (concat line (if (match-beginning 1) "<th></th>"

2933 "<td></td>"))

2934 i (match-end 0))))

2935 (setq line (concat line "</tr>"))))

2936 (goto-char cp)

2937 (if th

2938 (message

2939 "Type `%s' to change td from/to th."

2940 (key-description (car (where-is-internal 'yahtml-change-*)))))

2941 (if (string< "" line)

2942 (progn

2943 (insert line)

2944 (goto-char (+ 8 cp))

2945 (yahtml-indent-line)))))))

2946

2947 ;;; ---------- Marking ----------

2948 (defun yahtml-mark-begend ()

2949 "Mark current tag"

2950 (interactive)

2951 (YaTeX-beginning-of-environment)

2952 (let ((p (point)))

2953 (save-excursion

2954 (skip-chars-backward " \t" (point-beginning-of-line))

2955 (if (bolp) (setq p (point))))

2956 (push-mark p t))

2957 (yahtml-goto-corresponding-begend)

2958 (forward-list 1)

2959 (if (eolp) (forward-char 1)))

2960

2961 ;;; ---------- complete marks ----------

2962 (defun yahtml-complete-mark ()

2963 "Complete &gt, &lt, &ampersand, and &quote."

2964 (interactive)

2965 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2966 (let ((c (read-char)))

2967 (setq c (if (or (< c ?0) (> c ?7))

2968 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2969 (- c ?1)))

2970 (if (or (< c 0) (> c 6))

2971 nil

2972 (insert (format "&%s;"

2973 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2974

2975

2976 ;;; ---------- jump to error line ----------

2977 (defun yahtml-prev-error ()

2978 "Jump to previous error seeing lint buffer."

2979 (interactive)

2980 (or (get-buffer yahtml-lint-buffer)

2981 (error "No lint program ran."))

2982 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2983 (yahtml-jump-to-error-line t))

2984

2985 (defun yahtml-jump-to-error-line (&optional sit)

2986 (interactive "P")

2987 (let ((p (point)) (e (point-end-of-line)))

2988 (end-of-line)

2989 (if (re-search-backward yahtml-error-line-regexp nil t)

2990 (let ((f (if (string= "" (YaTeX-match-string 1))

2991 YaTeX-current-file-name

2992 (YaTeX-match-string 1)))

2993 (l (string-to-int (or (YaTeX-match-string 2)

2994 (YaTeX-match-string 3)))))

2995 (if sit (sit-for 1))

2996 (forward-line -1)

2997 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2998 (goto-line l))

2999 (message "No line number usage"))))

3000

3001 ;;; ---------- Style Sheet Support ----------

3002 (defvar yahtml-css-class-alist nil

3003 "Alist of elements vs. their classes")

3004

3005 (defun yahtml-css-collect-classes-region (beg end &optional initial)

3006 (save-excursion

3007 (save-restriction

3008 (narrow-to-region beg end)

3009 (goto-char (point-min))

3010 (let ((alist initial) b e element class a)

3011 (setq b (point))

3012 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

3013 (if (match-beginning 2)

3014 (let ((f (YaTeX-buffer-substring

3015 (progn (skip-chars-forward "^\"")(1+ (point)))

3016 (progn (forward-char 1)

3017 (skip-chars-forward "^\"")(point)))))

3018 (if (file-exists-p f)

3019 (setq alist

3020 (append alist (yahtml-css-collect-classes-file

3021 f initial)))))

3022 (setq e (point))

3023 (goto-char b)

3024 (while (re-search-forward ;ちょといい加減なREGEXP

3025 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

3026 e t)

3027 (setq element (YaTeX-match-string 1)

3028 class (YaTeX-match-string 2))

3029 ;;if starts with period (match-string 1 is nil),

3030 ;;this is global class

3031 (setq element (downcase (or element "*")))

3032 (if (setq a (assoc element alist))

3033 (or (assoc class (cdr a))

3034 (setcdr a (cons (list class) (cdr a))))

3035 (setq alist (cons (list element (list class)) alist))))

3036 (goto-char (1- e))

3037 (search-forward "}" nil 1) ;1=move to limit when not found.

3038 (setq b (point))))

3039 alist))))

3040

3041 (defun yahtml-css-collect-classes-buffer (&optional initial)

3042 (interactive)

3043 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

3044

3045 (defun yahtml-css-collect-classes-file (file &optional initial)

3046 (let*((hilit-auto-highlight nil)

3047 (buf (get-buffer-create

3048 (format " *css-collection*%s" (file-name-nondirectory file))))

3049 (cb (current-buffer)))

3050 (unwind-protect

3051 (progn

3052 (set-buffer buf)

3053 (insert-file-contents file)

3054 (cd (or (file-name-directory file) "."))

3055 (yahtml-css-collect-classes-buffer initial))

3056 (if (eq buf cb)

3057 nil

3058 (kill-buffer buf)

3059 (set-buffer cb)))))

3060

3061 (defun yahtml-css-scan-styles ()

3062 (save-excursion

3063 (goto-char (point-min))

3064 (set (make-local-variable 'yahtml-css-class-alist) nil)

3065 (let (b tag type e href alist)

3066 (while (re-search-forward "<\$style\\|link\$" nil t)

3067 (setq b (match-beginning 0)

3068 tag (YaTeX-match-string 1))

3069 (cond

3070 ((string-match "style" tag)

3071 (goto-char b)

3072 (save-excursion (forward-list 1) (setq e (point)))

3073 (cond

3074 ((search-forward "text/css" e 1) ;css definition starts

3075 (setq alist

3076 (yahtml-css-collect-classes-region

3077 (point) (progn (search-forward "</style>") (point))

3078 alist)))))

3079 ((and (string-match "link" tag)

3080 (stringp (setq type (yahtml-get-attrvalue "type")))

3081 (string-match "text/css" type)

3082 (setq href (yahtml-get-attrvalue "href"))

3083 (file-exists-p (yahtml-url-to-path href)))

3084 (setq alist

3085 (yahtml-css-collect-classes-file

3086 (yahtml-url-to-path href) alist))))

3087 (setq yahtml-css-class-alist alist)))))

3088

3089 (defun yahtml-css-get-element-completion-alist (element)

3090 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3091 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3092 (and (or alist global)

3093 (append alist global))))

3094

3095 ;;; ---------- ----------

3096

3097 ;;;

3098 ;;hilit19

3099 ;;;

3100 (defvar yahtml-default-face-table

3101 '(

3102 (form black/ivory white/hex-442233 italic)

3103 ))

3104 (defvar yahtml-hilit-patterns-alist

3105 '(

3106 'case-fold

3107 ;; comments

3108 ("" comment)

3109 ;; include&exec

3110 ("" include)

3111 ;; string

3112 (hilit-string-find ?\\ string)

3113 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3114 ("</?[uod]l>" 0 decl)

3115 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3116 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3117 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3118 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3119 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3120 ))

3121

3122 (defun yahtml-hilit-region-tag (tag)

3123 "Return list of start/end point of <TAG> form."

3124 (if (re-search-forward tag nil t)

3125 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3126 (elm (YaTeX-match-string 1)))

3127 (skip-chars-forward "^>")

3128 (prog1

3129 (cons (1+ (point))

3130 (progn (re-search-forward (concat "</" elm ">") nil t)

3131 (match-beginning 0)))

3132 (goto-char e0)))))

3133

3134 (defun yahtml-hilit-region-tag-itself (ptn)

3135 "Return list of start/end point of <tag options...> itself."

3136 (if (re-search-forward ptn nil t)

3137 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3138 (skip-chars-forward "^<>")

3139 (if (eq (char-after (point)) ?<) nil

3140 (prog1

3141 (cons m0 (min (point-max) (1+ (point))))

3142 (goto-char e0))))))

3143

3144 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3145 (and yahtml-use-hilit19

3146 (or (assq 'yahtml-mode hilit-patterns-alist)

3147 (setq hilit-patterns-alist

3148 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3149 hilit-patterns-alist))))

3150 ;;;

3151 ;; for font-lock

3152 ;;;

3153

3154 ; <<STATIC KEYWORDS BELOW NOT USED>>

3155 ;(defvar yahtml-font-lock-keywords

3156 ; '(

3157 ; ;; comments

3158 ; ("" . font-lock-comment-face)

3159 ; ;; include&exec

3160 ; (""

3161 ; 0 font-lock-include-face keep)

3162 ; ;; string

3163 ; ;(hilit-string-find ?\\ string)

3164 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3165 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3166 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3167 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3168 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3169 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3170 ; )

3171 ; "*Defualt font-lock-keywords for yahtml-mode.")

3172 (defvar yahtml-font-lock-keywords

3173 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3174 "Default fontifying patterns for yahtml-mode")

3175

3176 (defun yahtml-font-lock-set-default-keywords ()

3177 (put 'yahtml-mode 'font-lock-defaults

3178 '(yahtml-font-lock-keywords nil t)))

3179

3180 (if yahtml-use-font-lock

3181 (progn

3182 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3183 ;;for those who use both hilit19 and font-lock

3184 (if (eq (car hilit-mode-enable-list) 'not)

3185 (or (member 'yahtml-mode hilit-mode-enable-list)

3186 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3187 (setq hilit-mode-enable-list

3188 (delq 'yahtml-mode hilit-mode-enable-list))))

3189 (yahtml-font-lock-set-default-keywords)))

3190

3191 (defun yahtml-font-lock-recenter (&optional arg)

3192 (interactive "P")

3193 (font-lock-mode -1) ;is stupid, but sure.

3194 (font-lock-mode 1))

3195

3196 ;;;

3197 ;; Drag-n-Drop

3198 ;;;

3199 (defun yahtml-dnd-handler (uri action)

3200 "DnD handler for yahtml mode

3201 Convert image URI to img-src and others to a-href."

3202 (let*((file (dnd-get-local-file-name uri))

3203 (path (if file (file-relative-name file) uri))

3204 (case-fold-search t)

3205 (geom ""))

3206 (cond

3207 ((memq action '(copy link move private))

3208 (cond

3209 ((string-match "\\.\$jpe?g\\|png\\|gif\\|bmp\\|tiff?\$$" path)

3210 (if file

3211 (setq geom (yahtml-get-image-info path)

3212 geom (if (car geom)

3213 (apply 'format " width=\"%s\" height=\"%s\"" geom)

3214 "")))

3215 (insert (format "<img src=\"%s\" alt=\"%s\"%s>"

3216 path (file-name-nondirectory path) geom)))

3217

3218 (t (insert (format "<a href=\"%s\"></a>" path))

3219 (forward-char -4))))

3220 (t (message "No handler for action `%s'" action))))

3221 action)

3222

3223 (run-hooks 'yahtml-load-hook)

3224 (provide 'yahtml)

3225

3226 ; Local variables:

3227 ; fill-prefix: ";;; "

3228 ; paragraph-start: "^$\\|\\|;;;$"

3229 ; paragraph-separate: "^$\\|\\|;;;$"

3230 ; coding: sjis

3231 ; End: