yatex: 781604df4cbd yahtml.el

yatex

view yahtml.el @ 409:781604df4cbd

New variables: YaTeX-electric-indent-mode, yahtml-electric-indent-mode

author	HIROSE Yuuji <yuuji@gentei.org>
date	Wed, 11 Feb 2015 11:45:37 +0900
parents	2fc714f03ddf
children	a4a2635c5158

line source

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

3 ;;; Last modified Wed Feb 11 08:58:55 2015 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.78.1"

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 (defvar yahtml-electric-indent-mode -1

290 "*(Emacs 24.4+) Pass this value to electric-indent-local-mode.

291 -1 means `off'.")

292

293 ;;; --- customizable variable ends here ---

294 (defvar yahtml-prefix-map nil)

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

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

297 (defvar yahtml-shell-command-option

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

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

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

301

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

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

304 (YaTeX-define-key

305 key

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

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

308 map))

309

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

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

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

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

314

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

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

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

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

319 (if YaTeX-inhibit-prefix-letter nil

320 (yahtml-define-begend-region-key

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

322

323 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

336 (let ((map yahtml-prefix-map))

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

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

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

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

341 (and YaTeX-emacs-19 window-system

342 (progn

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

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

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

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

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

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

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

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

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

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

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

354 (if YaTeX-no-begend-shortcut

355 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

394 (substitute-all-key-definition

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

396 (substitute-all-key-definition

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

398

399 (if yahtml-lint-buffer-map nil

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

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

402

403

404 (defvar yahtml-paragraph-start

405 (concat

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

407 "*Regexp of html paragraph separater")

408 (defvar yahtml-paragraph-separate

409 (concat

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

411 "*Regexp of html paragraph separater")

412 (defvar yahtml-syntax-table nil

413 "*Syntax table for yahtml-mode")

414

415 (if yahtml-syntax-table nil

416 (setq yahtml-syntax-table

417 (make-syntax-table (standard-syntax-table)))

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

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

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

421

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

423 "Regexp of constituent of html commands.")

424

425 ;;; Completion tables for `form'

426 (defvar yahtml-form-table

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

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

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

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

431

432 (defvar yahtml-env-table

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

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

435 ("OrderedList" . "ol")

436 ("UnorderedList" . "ul")

437 ("DefinitionList" . "dl")

438 ("Preformatted" . "pre")

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

440 ("address") ("button")

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

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

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

444 ("option")

445 ))

446

447 (if yahtml-html4-strict

448 (setq yahtml-env-table

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

450

451 ;(defvar yahtml-itemizing-regexp

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

453 ; "Regexp of itemizing forms")

454

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

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

457

458 ;;; Completion tables for typeface designator

459 (and yahtml-always-/p

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

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

462 (and yahtml-always-/li

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

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

465 (and yahtml-always-/dt

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

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

468 (and yahtml-always-/dd

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

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

471

472 (defvar yahtml-typeface-table

473 (append

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

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

476 ("sup") ("sub") ("span") ("abbr"))

477 (if (not yahtml-html4-strict)

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

479 yahtml-env-table)

480 "Default completion table of typeface designator")

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

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

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

484

485 (defvar yahtml-single-cmd-table

486 '(("hr") ("br") ("option")

487 ("HorizontalRule" . "hr")

488 ("BreakLine" . "br")

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

490 ("!--#exec")

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

492 ("!--#include")

493 ;; ("Item" . "li")

494 ;; ("DefineTerm" . "dt")

495 ;; ("Description" . "dd")

496 ;; ("dd") ("dt") ("li")

497 )

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

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

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

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

502

503 (defvar yahtml-current-completion-type nil

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

505

506 (defvar yahtml-struct-name-regexp

507 (concat

508 "\\<\\("

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

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

511 "\\)\\b")

512 "Regexp of structure beginning.")

513

514 (defvar yahtml-closable-regexp

515 (concat

516 "\\<\\("

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

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

519 "\\)\\b")

520 "Regexp of any closable elemnts.")

521

522 (defvar yahtml-indent-listing-constant t

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

524 T for static indentation depth")

525

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

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

528

529

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

531 (cond

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

533 buffer-file-name)

534 (let ((dir default-directory)

535 charset af ext (ldir "")

536 line

537 (case-fold-search t)

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

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

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

541 (while (and dir

542 (not (string= dir ldir))

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

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

545 (if (file-exists-p af)

546 (save-excursion

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

548 (save-excursion

549 (goto-char (point-min))

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

551 (setq line (buffer-substring

552 (point-beginning-of-line)

553 (point-end-of-line))

554 dir nil)))

555 (kill-buffer (current-buffer))))

556 (if dir

557 (setq ldir dir

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

559 dir (file-name-directory dir))))

560 line))

561 (t nil)))

562

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

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

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

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

567 (case-fold-search t)

568 line

569 charset)

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

571 (progn

572 (string-match ptn line)

573 (setq charset

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

575 (cond

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

577 (setq charset 2))

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

579 (setq charset 3))

580 ((string-match "shift_jis" charset)

581 (setq charset 1))

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

583 (setq charset 4))

584 (t (setq charset nil)))

585 (setq dir "")))

586 (if (featurep 'mule)

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

588 charset))

589

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

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

592 x index-list)

593 ;;s/\\s *$//;

594 (if line

595 (progn

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

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

598 (while (string< "" line)

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

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

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

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

603 line "")))

604 (or (nreverse index-list)

605 (if (listp yahtml-directory-index)

606 yahtml-directory-index

607 (list yahtml-directory-index)))))))

608

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

610 (defun yahtml-mode ()

611 (interactive)

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

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

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

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

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

617 (cond

618 ((null coding) nil)

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

620 (setq buffer-file-coding-system

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

622 (save-excursion

623 (goto-char (point-min))

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

625 coding)))

626 ((featurep 'mule)

627 (set-file-coding-system coding))

628 ((boundp 'NEMACS)

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

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

631 (setq major-mode 'yahtml-mode

632 mode-name "yahtml"

633 YaTeX-current-file-name (file-name-nondirectory

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

635 local-abbrev-table yahtml-mode-abbrev-table)

636 (mapcar

637 (function (lambda (x)

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

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

640 (boundp (cdr x)))

641 (symbol-value (cdr x))

642 (cdr x)))))

643 '((YaTeX-ec . "")

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

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

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

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

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

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

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

651 (paragraph-start . yahtml-paragraph-start)

652 (paragraph-separate . yahtml-paragraph-separate)

653 (comment-start . "")

654 (comment-start-skip . comment-start)

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

656

657 (if yahtml-use-font-lock

658 (progn

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

660 (or (featurep 'xemacs)

661 (progn

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

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

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

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

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

667 (font-lock-fontify-buffer)))))

668 ;; +dnd for X11 w/ emacs23+

669 (and window-system (featurep 'dnd)

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

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

672 dnd-protocol-alist)))

673

674 (set-syntax-table yahtml-syntax-table)

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

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

677 (yahtml-css-scan-styles)

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

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

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

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

682 (if (fboundp 'electric-indent-local-mode)

683 (electric-indent-local-mode yahtml-electric-indent-mode))

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

685

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

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

688 font-lock-defaults)

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

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

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

692

693 (defun yahtml-version ()

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

695 (interactive)

696 (message

697 (concat "Yet Another HTML-mode "

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

699 " Revision "

700 yahtml-revision-number)))

701

702 (defun yahtml-quit ()

703 (interactive)

704 (and yahtml-mode-old-mode

705 (fboundp yahtml-mode-old-mode)

706 (funcall yahtml-mode-old-mode)))

707

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

709 (cond

710 ((featurep 'xemacs)

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

712 (set keymap nil)

713 (mapcar

714 (function

715 (lambda (bind)

716 (setq bind (cdr bind))

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

718 (setcar (cdr bind) 'progn))

719 (if (stringp (car (cdr bind)))

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

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

722 (symbol-value keymap))))))

723 bindlist)

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

725 (t

726 (mapcar

727 (function

728 (lambda (bind)

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

730 bindlist))))

731

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

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

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

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

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

737

738 ;;; Variables for mosaic url history

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

740 (defvar yahtml-urls-private nil)

741 (defvar yahtml-urls-local nil)

742

743 (cond

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

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

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

747 (YaTeX-define-menu

748 'yahtml-menu-map-sectioning

749 (nreverse

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

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

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

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

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

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

756 )))

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

758 (YaTeX-define-menu

759 'yahtml-menu-map-logical

760 (nreverse

761 '((em "Embolden" .

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

763 (dfn "Define a word" .

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

765 (cite "Citation" .

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

767 (code "Code" .

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

769 (kbd "Keyboard" .

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

771 (samp "Sample display" .

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

773 (strong "Strong" .

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

775 (VAR "Variable notation" .

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

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

778 (YaTeX-define-menu

779 'yahtml-menu-map-typeface

780 (nreverse

781 '((b "Bold" .

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

783 (i "Italic" .

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

785 (tt "Typewriter" .

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

787 (u "Underlined" .

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

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

790 (YaTeX-define-menu

791 'yahtml-menu-map-listing

792 (nreverse

793 '((ul "Unordered" .

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

795 (ol "Ordered" .

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

797 (dl "Definition" .

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

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

800 (YaTeX-define-menu

801 'yahtml-menu-map-item

802 (nreverse

803 '((li "Simple item" .

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

805 (dt "Define term" .

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

807 (dd "Description of term" .

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

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

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

811 (YaTeX-define-menu

812 'yahtml-menu-map

813 (nreverse

814 (list

815 (cons (list 'sect "Sectioning")

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

817 (cons (list 'list "Listing")

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

819 (cons (list 'item "Item")

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

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

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

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

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

825 (if (featurep 'xemacs)

826 (add-hook 'yahtml-mode-hook

827 (function

828 (lambda ()

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

830 (progn

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

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

833

834 ;;; ----------- Completion ----------

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

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

837 "Insert <cmd> ... </cmd>."

838 (interactive "P")

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

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

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

842 (cmd

843 (or env

844 (YaTeX-cplread-with-learning

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

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

847 (bolp (save-excursion

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

849 (cc (current-column)))

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

851 (setq yahtml-last-begend

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

853 yahtml-last-begend))

854 (setq cmd yahtml-last-begend)

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

856 (if region

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

858 ;; to enable continuous regioning by another environment

859 (let ((beg (region-beginning))

860 (end (region-end))

861 (addin (yahtml-addin cmd)))

862 (save-excursion

863 (goto-char end)

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

865 (goto-char beg)

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

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

868 (save-excursion

869 (insert "\n")

870 (indent-to-column cc)

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

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

873 (newline)

874 (yahtml-intelligent-newline nil))

875 (yahtml-indent-line))))

876

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

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

879 (interactive)

880 (yahtml-insert-begend t))

881

882

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

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

885 (interactive)

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

887 (or form

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

889 (setq form

890 (YaTeX-cplread-with-learning

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

892 'yahtml-form-table 'yahtml-user-form-table

893 'yahtml-tmp-form-table))))

894 (let ((p (point)) q)

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

896 (setq yahtml-last-form form)

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

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

899 ;;(indent-relative-maybe)

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

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

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

903

904 (defun yahtml-read-css (alist &optional element)

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

906 (minibuffer-completion-table alist)

907 (quotekey (substitute-command-keys "\\[quoted-insert]")))

908 (read-from-minibuffer-with-history

909 (if YaTeX-japan

910 (format "%sクラス(複数指定は%s SPCで区切る): "

911 (if element (concat element "の") "") quotekey)

912 (format "class%s(multiple class can be delimited by %s SPC): "

913 (if element (concat " for " element) "") quotekey))

914 nil YaTeX-minibuffer-completion-map nil)))

915

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

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

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

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

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

921 (defun yahtml-newpage (file ov)

922 "Create newpage via newpage script"

923 (interactive

924 (list

925 (let (insert-default-directory)

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

927 current-prefix-arg))

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

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

930 (insert (substring

931 (YaTeX-command-to-string

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

933 0 -1)))

934

935 ;;; ---------- Add-in ----------

936 (defun yahtml-addin (form)

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

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

939 (concat

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

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

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

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

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

945 "class" (yahtml-read-css a form)))

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

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

948 (string< "" s))

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

950 ""))))

951

952 (defvar yahtml-completing-buffer nil)

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

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

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

956 (let (list end)

957 (save-excursion

958 (set-buffer yahtml-completing-buffer)

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

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

961 (save-excursion

962 (goto-char (point-min))

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

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

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

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

967 (setq end (match-end 0))

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

969 (yahtml-on-assignment-p)

970 (progn

971 (goto-char end)

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

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

974 (setq list (cons

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

976 list))))

977 list))))

978

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

980 (if yahtml-url-completion-map nil

981 (setq yahtml-url-completion-map

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

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

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

985

986 (defun yahtml-complete-url ()

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

988 (interactive)

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

990 (lim (YaTeX-minibuffer-begin))

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

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

993 (cond

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

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

996 listfunc (list 'lambda nil

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

998 beg min))

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

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

1001 (progn

1002 (setq path (substring initial 0 beg))

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

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

1005 (setq initial (substring initial beg))

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

1007 cmpl (try-completion initial labels)

1008 listfunc (list 'lambda ()

1009 (list 'all-completions

1010 initial (list 'quote labels)))

1011 beg (+ min beg)))

1012 (t

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

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

1015 initial))

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

1017 file (file-name-nondirectory path)

1018 initial file

1019 cmpl (file-name-completion file dir)

1020 listfunc (list 'lambda nil

1021 (list 'file-name-all-completions

1022 file dir))

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

1024 (cond

1025 ((stringp cmpl)

1026 (if (string= initial cmpl)

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

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

1029 (princ

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

1031 (delete-region (point) beg)

1032 (insert cmpl)))

1033 ((null cmpl)

1034 (ding))

1035 ((eq t cmpl)

1036 (save-excursion

1037 (unwind-protect

1038 (progn

1039 (goto-char p)

1040 (insert " [Sole completion]"))

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

1042

1043 ;

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

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

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

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

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

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

1050 ;

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

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

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

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

1055 (defvar yahtml-unsafe-chars-regexp

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

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

1058 ;

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

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

1061 ;

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

1063 ; "$" | ","

1064 (defvar yahtml-unreserved-chars-regexp

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

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

1067 Not used yet.")

1068

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

1070 "Translate reserved chars to URL encoded string."

1071 (let ((p 0) (target "")

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

1073 (cond

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

1075 (t

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

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

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

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

1080 (setq target (concat target

1081 (substring str 0 p)

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

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

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

1085 (concat target str)))))

1086

1087 (defun yahtml-unescape-string (str)

1088 "Untranslate reserved URL-encoded string."

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

1090 (unwind-protect

1091 (progn

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

1093 (setq target (concat target

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

1095 p (match-end 0)

1096 c (YaTeX-hex (substring

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

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

1099 (concat target (substring str p)))

1100 (store-match-data md))))

1101

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

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

1104 (interactive "r")

1105 (save-excursion

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

1107 (goto-char beg)

1108 (while (and (< (point) e)

1109 (re-search-forward

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

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

1112 (sit-for 0)

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

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

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

1116 ; (unwind-protect

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

1118 ; (save-excursion

1119 ; (backward-char 1)

1120 ; (delete-backward-char 4))

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

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

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

1124 (progn

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

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

1127 (set-marker e nil))))

1128 ;; ab%defgls/.|

1129

1130 (defun yahtml:a ()

1131 "Add-in function for <a>"

1132 (let ((href ""))

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

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

1135 href (yahtml-escape-chars-string

1136 (read-from-minibuffer-with-history

1137 "href: " "" yahtml-url-completion-map)))

1138 (prog1

1139 (concat (yahtml-make-optional-argument

1140 "href" href)

1141 (yahtml-make-optional-argument

1142 "name" (read-string-with-history "name: ")))

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

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

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

1146 (YaTeX-update-table

1147 (list href)

1148 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1149

1150 (defvar yahtml-parameters-completion-alist

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

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

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

1154 ("src" . file) ("file" . file)

1155 ("background" . file)

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

1157 ("method" ("POST") ("GET"))

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

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

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

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

1162 ("http-equiv" ("Refresh"))))

1163

1164 (defvar yahtml-link-types-alist

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

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

1167 ("subsection") ("appendix") ("help") ("bookmark")))

1168

1169 (defvar yahtml-content-types-alist

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

1171 ("text/sgml") ("text/xml")

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

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

1174 ("application/java")

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

1176 "Alist of content-types")

1177

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

1179 (let* ((alist

1180 (cdr-safe (assoc (downcase par)

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

1182 (prompt (concat par ": "))

1183 v)

1184 (cond

1185 ((eq alist 'file)

1186 (let ((insert-default-directory))

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

1188 ((eq alist 'command)

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

1190 (read-shell-command prompt)

1191 (read-string-with-history prompt)))

1192 ((and alist (symbolp alist))

1193 (completing-read-with-history

1194 prompt (symbol-value alist) nil nil default))

1195 (alist

1196 (completing-read-with-history prompt alist nil nil default))

1197 (t

1198 (read-string-with-history prompt default)))))

1199

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

1201 "Make optional argument string."

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

1203 ""

1204 (concat " "

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

1206 "=\"" arg "\"")))

1207

1208 (defun yahtml:html ()

1209 "Add-in for <html>"

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

1211 (yahtml-make-optional-argument

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

1213

1214 (defun yahtml:head ()

1215 "Add-in for <head>"

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

1217 "")

1218

1219 (defun yahtml:body ()

1220 "Add-in function for <body>"

1221 (cond

1222 (yahtml-html4-strict nil)

1223 (t

1224 (let ((b (read-string-with-history "bgcolor="))

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

1226 (x (read-string-with-history "text color="))

1227 (l (read-string-with-history "link color="))

1228 (v (read-string-with-history "vlink color=")))

1229 (concat

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

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

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

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

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

1235

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

1237 "Make CSS property definitions in style attribute."

1238 (mapconcat

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

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

1241 (delq nil proplist)

1242 " "))

1243

1244 (defun yahtml:img ()

1245 "Add-in function for <img>"

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

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

1248 alt

1249 (brd (read-string-with-history "border="))

1250 (l yahtml-prefer-upcase-attributes)

1251 info width height bytes comments)

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

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

1254 (car info)

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

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

1257 bytes (car (cdr (cdr info)))

1258 comments (nth 4 info)))

1259 (if info

1260 (setq alt

1261 (YaTeX-replace-formats

1262 yahtml:img-default-alt-format

1263 (list (cons "x" width)

1264 (cons "y" height)

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

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

1267 (cons "c" (car comments))))))

1268

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

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

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

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

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

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

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

1276 (if yahtml-html4-strict

1277 (yahtml-make-optional-argument

1278 "style"

1279 (if (or brd alg)

1280 (yahtml-make-style-parameter

1281 (list

1282 (if (string< "" alg)

1283 (cons "align" alg))

1284 (if (string< "" brd)

1285 (cons "border"

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

1287 (concat

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

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

1290

1291 (defun yahtml-file-truename (file)

1292 (cond

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

1294 (t (let ((new file))

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

1296 (not (equal new file)))

1297 (setq file new))

1298 file))))

1299

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

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

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

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

1304 (let ((mlt 1)

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

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

1307 (value 0))

1308 (while (> length 0)

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

1310 pos (+ pos direc)

1311 mlt (* mlt 256)

1312 length (1- length)))

1313 value))

1314

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

1316 "Return the information on the image file FILE.

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

1318 (save-excursion

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

1320 width height bytes depth comment

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

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

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

1324 (seekpoint 1)

1325 c1 c2 c3 c4 beg end

1326 (case-fold-search nil))

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

1328 (set-buffer tmpbuf)

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

1330 (erase-buffer)

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

1332 (unwind-protect

1333 (progn

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

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

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

1337 (YaTeX-insert-file-contents

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

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

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

1341 c2 (char-after 2)

1342 c3 (char-after 3)

1343 c4 (char-after 4))

1344 (cond

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

1346 ;;JPEG images need JPEG markers inspection

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

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

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

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

1351 (catch 'exit

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

1353 (cond

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

1355 ;maybe corrupted, exit from loop

1356 (throw 'exit t))

1357 ((memq

1358 (char-after (1+ seekpoint))

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

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

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

1362 ;;found!

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

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

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

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

1367 ;; JPEG comment area

1368 (setq beg (+ seekpoint 2 2)

1369 end (+ seekpoint

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

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

1372 (t ;other markers

1373 nil)) ;just skip it

1374 (setq seekpoint (+ seekpoint 2)

1375 seekpoint (+ seekpoint

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

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

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

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

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

1381 height (yahtml-hex-value 20 4)

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

1383 ((looking-at "GIF8")

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

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

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

1387 ((looking-at "BM")

1388 ;;# OS/2, Windoze BMP files

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

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

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

1392 (cond

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

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

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

1396 (t

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

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

1399 (message "")

1400 (kill-buffer tmpbuf))

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

1402

1403 (defun yahtml:form ()

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

1405 (concat

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

1407 (completing-read-with-history "Method: " '(("POST") ("GET")) nil t)

1408 "\""

1409 (yahtml-make-optional-argument

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

1411 (completing-read-with-history

1412 "Enctype: "

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

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

1415 (read-string-with-history "Action: ") "\""))

1416

1417 (defun yahtml:select ()

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

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

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

1421 (read-string-with-history "name: ") "\""))

1422

1423 (defun yahtml:ol ()

1424 "Add-in function for <ol>"

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

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

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

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

1429 (concat

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

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

1432 (defun yahtml:ul ()

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

1434 (defun yahtml:dl ()

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

1436 (defun yahtml:dt ()

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

1438

1439 (defun yahtml:p ()

1440 (if yahtml-html4-strict nil

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

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

1443

1444 (defvar yahtml-input-types

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

1446 ("reset") ("image") ("hidden") ("file")))

1447

1448 (defun yahtml:input ()

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

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

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

1452 (setq name (read-string-with-history "name: ")

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

1454 yahtml-input-types nil t)

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

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

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

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

1459 (concat

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

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

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

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

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

1465

1466 (defun yahtml:textarea ()

1467 "Add-in function for `textarea'"

1468 (interactive)

1469 (let (name rows cols)

1470 (setq name (read-string-with-history "Name: ")

1471 cols (read-string-with-history "Columns: ")

1472 rows (read-string-with-history "Rows: "))

1473 (concat

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

1475 "\"" name "\"")

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

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

1478

1479 (defun yahtml:table ()

1480 "Add-in function for `table'"

1481 (let ((b (read-string-with-history "border="))

1482 (a (yahtml-read-parameter

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

1484 (if yahtml-html4-strict

1485 (yahtml-make-optional-argument

1486 "style"

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

1488 (yahtml-make-style-parameter

1489 (append

1490 (if (string< "" b)

1491 (list

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

1493 (cons "border-collapse" "collapse")))

1494 (if (string< "" a)

1495 (cond

1496 ((string-match "right" a)

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

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

1499 ((string-match "center" a)

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

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

1502 (concat

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

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

1505

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

1507 (defun yahtml:caption ()

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

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

1510 (if yahtml-html4-strict

1511 (yahtml-make-optional-argument

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

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

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

1515

1516 (defun yahtml:font ()

1517 "Add-in function for `font'"

1518 (concat

1519 (yahtml-make-optional-argument "color" (read-string-with-history "color="))

1520 (yahtml-make-optional-argument "size" (read-string-with-history "size="))))

1521

1522 (defun yahtml:style ()

1523 "Add-in function for `style'"

1524 (yahtml-make-optional-argument

1525 "type" (read-string-with-history "type=" "text/css")))

1526

1527 (defun yahtml:script ()

1528 "Add-in function for `script'"

1529 (concat

1530 (yahtml-make-optional-argument

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

1532 (yahtml-make-optional-argument

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

1534

1535 (defun yahtml:tr ()

1536 "Add-in function for `tr'"

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

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

1539 "")

1540

1541 (defun yahtml:link ()

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

1543 (let (rel rev type href)

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

1545 (cond

1546 ((equal rel "")

1547 (concat (yahtml-make-optional-argument

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

1549 (yahtml-make-optional-argument

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

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

1552 )))

1553 ((string-match "stylesheet" rel)

1554 (concat

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

1556 (yahtml-make-optional-argument

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

1558 (progn

1559 (setq href

1560 (read-from-minibuffer-with-history

1561 "href: " "" yahtml-url-completion-map))

1562 (if (string< "" href)

1563 (progn

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

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

1566 (setq yahtml-css-class-alist

1567 (yahtml-css-collect-classes-file

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

1569 (message "")

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

1571 (t

1572 (concat

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

1574 (yahtml-make-optional-argument

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

1576 (yahtml-make-optional-argument

1577 "href"

1578 (read-from-minibuffer-with-history

1579 "href: " "" yahtml-url-completion-map)))))))

1580

1581 (defvar yahtml:meta-names

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

1583

1584 (defun yahtml:meta ()

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

1586 "name"

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

1588 http-equiv content)

1589 (if (string= "" name)

1590 (if (string-match

1591 "Content-type"

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

1593 "http-equiv"

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

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

1596 "See docs/qanda")

1597 (concat http-equiv

1598 (yahtml-make-optional-argument

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

1600 (concat

1601 name

1602 (yahtml-make-optional-argument

1603 "content"

1604 (cond

1605 ((string-match "date" name)

1606 (read-string-with-history "Date: " (current-time-string)))

1607 ((string-match "author" name)

1608 (read-string-with-history "Author: "

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

1610 (user-full-name)

1611 (user-login-name))))

1612 ((string-match "GENERATOR" name)

1613 (setq content (read-string-with-history

1614 "Generator: " "User-agent: "))

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

1616 (message "Thank you!"))

1617 content)

1618 (t (read-string-with-history (concat name ": ")))))))))

1619

1620 (defun yahtml:br ()

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

1622

1623 (defun yahtml:object ()

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

1625 data classid)

1626 (cond

1627 ((string-match "java" codetype)

1628 (let ((completion-ignored-extensions

1629 ;;any extensions except ".class"

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

1631 (setq classid (concat "java:"

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

1633 (concat

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

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

1636 (yahtml-make-optional-argument

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

1638 (yahtml-make-optional-argument

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

1640 (yahtml-make-optional-argument

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

1642 (t

1643 ""))))

1644

1645 (defun yahtml:abbr ()

1646 "Add-in function for abbr."

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

1648

1649 (defun yahtml:button ()

1650 (concat

1651 (yahtml-make-optional-argument

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

1653 (yahtml-make-optional-argument

1654 "type" (yahtml-read-parameter

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

1656 (yahtml-make-optional-argument

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

1658

1659 ;;; ---------- Simple tag ----------

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

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

1662 (interactive "P")

1663 (setq yahtml-current-completion-type 'inline

1664 region-mode (or region-mode (YaTeX-region-active-p)))

1665 (or tag

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

1667 (setq tag

1668 (YaTeX-cplread-with-learning

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

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

1671 'yahtml-typeface-table 'yahtml-user-typeface-table

1672 'yahtml-tmp-typeface-table))))

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

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

1675 (setq yahtml-last-typeface-cmd tag

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

1677 (if region-mode

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

1679 (save-excursion

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

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

1682 (exchange-point-and-mark)

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

1684 (message "No mark set now"))

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

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

1687

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

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

1690 (interactive)

1691 (yahtml-insert-tag t tag))

1692

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

1694 (defun yahtml-insert-single (cmd)

1695 "Insert <CMD>."

1696 (interactive

1697 (list

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

1699 (YaTeX-cplread-with-learning

1700 (format "Command%s: "

1701 (if yahtml-last-single-cmd

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

1703 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1706 (setq yahtml-last-single-cmd

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

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

1709 yahtml-last-single-cmd))

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

1711 cmd

1712 (yahtml-addin cmd)

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

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

1715 " /" "")))

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

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

1718

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

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

1721 (interactive "P")

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

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

1724

1725 (defun yahtml-insert-amps (arg)

1726 "Insert char-entity references via ampersand"

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

1728 (interactive "P")

1729 (let*((mess "") c

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

1731 yahtml-entity-reference-chars-alist))

1732 (l list))

1733 (while l

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

1735 l (cdr l)))

1736 (message "Char-entity reference: %s SPC=& RET=&; BS=%s Other=&#..;"

1737 mess (if YaTeX-japan "直前の文字" "Preceding-Char"))

1738 (setq c (read-char))

1739 (cond

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

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

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

1743 (insert "&;")

1744 (forward-char -1))

1745 ((equal c ? )

1746 (insert ?&))

1747 ((and (memq c '(127 8))

1748 (setq c (preceding-char))

1749 (delete-backward-char 1)

1750 nil)) ;Fall through to the next 't block

1751 (t (insert (format "&#x%x;" c))))))

1752

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

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

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

1756

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

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

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

1760

1761 ;;; ---------- Jump ----------

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

1763 "Check if point is on href clause."

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

1765 (save-excursion

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

1767 (save-excursion

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

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

1770 (setq e (point)))

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

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

1773 (search-forward "href" e t)

1774 (search-forward "=" e t)

1775 (progn

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

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

1778 (< p (match-end 0))

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

1780

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

1782 (cond

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

1784 (set-process-buffer proc nil))

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

1786 (let ((cb (current-buffer)))

1787 (set-buffer (process-buffer proc))

1788 (goto-char (point-min))

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

1790 (progn

1791 (message "Starting netscape...")

1792 (start-process

1793 "browser" (process-buffer proc)

1794 shell-file-name yahtml-shell-command-option

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

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

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

1798 (set-buffer cb)))))

1799

1800 (defvar yahtml-browser-process nil)

1801

1802 (defun yahtml-browse-html (href)

1803 "Call WWW Browser to see HREF."

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

1805 (cond

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

1807 (if (get-buffer pb)

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

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

1810 (set-process-sentinel

1811 (setq yahtml-browser-process

1812 (start-process

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

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

1815 'yahtml-netscape-sentinel))

1816 ((and (string-match

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

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

1819 (if (get-buffer pb)

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

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

1822 (set-process-sentinel

1823 (setq yahtml-browser-process

1824 (start-process

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

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

1827 'yahtml-netscape-sentinel))

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

1829 (w3-fetch href))

1830 ((stringp yahtml-www-browser)

1831 (if (and yahtml-browser-process

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

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

1834 (setq yahtml-browser-process

1835 (start-process

1836 "browser" "* WWW Browser *"

1837 shell-file-name yahtml-shell-command-option

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

1839 (t

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

1841

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

1843 "Go to corresponding name."

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

1845 (if href

1846 (cond

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

1848 (yahtml-browse-html href))

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

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

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

1852 (if (string< "" file)

1853 (progn

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

1855 (or (catch 'dirindex

1856 (mapcar

1857 (function

1858 (lambda (f)

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

1860 (throw 'dirindex

1861 (setq file (concat file f))))))

1862 (yahtml-get-directory-index))

1863 nil)

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

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

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

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

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

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

1870 (if name

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

1872 t)))))

1873

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

1875 "Jump to html's named tag."

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

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

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

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

1880

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

1882 "Check if point is on begend clause."

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

1884 (save-excursion

1885 (goto-char p)

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

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

1888 (looking-at

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

1890 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1891 (condition-case nil

1892 (forward-list 1)

1893 (error nil))

1894 (< p (point)))

1895 (YaTeX-match-string 1)))))

1896

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

1898 "Go to corresponding opening/closing tag.

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

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

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

1902 (cond

1903 (cmd

1904 (setq m0 (match-beginning 0))

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

1906 (setq cmd (substring cmd 1)

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

1908 func 're-search-backward)

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

1910 func 're-search-forward))

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

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

1913 nil

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

1915 (if (< nest 0)

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

1917 (funcall

1918 (if noerr 'message 'error)

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

1920 (goto-char p)

1921 nil))

1922 (t nil))))

1923

1924 (defun yahtml-current-tag ()

1925 "Return the current tag name including #exec and #include."

1926 (save-excursion

1927 (let ((p (point)) b tag)

1928 (or (bobp)

1929 (looking-at "<")

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

1931 (setq b (point))

1932 (skip-chars-forward "<")

1933 (setq tag (YaTeX-buffer-substring

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

1935 (goto-char b)

1936 (forward-list 1)

1937 (and (< p (point)) tag))))

1938

1939 (defun yahtml-get-attrvalue (attr)

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

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

1942 (save-excursion

1943 (or (looking-at "<")

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

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

1946 (if (and

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

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

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

1950 (YaTeX-match-string 1)))))

1951

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

1953 "View image on point"

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

1955 (if (and tag

1956 (string-match "img" tag)

1957 (setq image

1958 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1959 (progn

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

1961 (start-process

1962 "Viewer" " * Image Viewer *"

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

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

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

1966

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

1968 "Goto applet's or script's source."

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

1970 (cond

1971 ((string-match "applet" env)

1972 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1973 (progn

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

1975 s (concat

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

1977 ".java"))

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

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

1980 s) ;return source file name

1981 (message "No applet source specified")

1982 (sit-for 1)

1983 nil))

1984 ((string-match "script" env)

1985 (if (setq s (yahtml-get-attrvalue "src"))

1986 (progn

1987 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1988 'YaTeX-switch-to-buffer)

1989 (yahtml-url-to-path s))

1990 s)))

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

1992 (cond

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

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

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

1996 s)

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

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

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

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

2001 s)))

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

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

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

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

2006 (unwind-protect

2007 (progn

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

2009 (YaTeX-insert-file-contents s nil 0 100)

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

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

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

2013 (kill-buffer (get-buffer b)))

2014 (get-file-buffer s))))))

2015

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

2017 "Go to corresponding object."

2018 (interactive "P")

2019 (cond

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

2021 ((yahtml-goto-corresponding-img))

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

2023 ((yahtml-goto-corresponding-begend))

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

2025

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

2027 "Go to corresponding object."

2028 (interactive)

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

2030

2031 (defun yahtml-visit-main ()

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

2033 (interactive)

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

2035

2036 ;;; ---------- killing ----------

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

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

2039 (if tag

2040 (save-excursion

2041 (or (looking-at "<")

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

2043 (setq p (point))

2044 (yahtml-goto-corresponding-begend)

2045 (or (looking-at "<")

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

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

2048 (progn (setq q p p (point))

2049 (goto-char q))

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

2051 (if (not whole)

2052 (kill-region

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

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

2055 (progn (forward-list 1)

2056 (setq r (point))

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

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

2059 (goto-char p)

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

2061 (if (not whole)

2062 (progn

2063 (kill-append

2064 (buffer-substring

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

2066 (setq q (progn

2067 (forward-list 1)

2068 (setq r (point))

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

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

2071 (1+ (point))

2072 r))))

2073 t)

2074 (delete-region p q))

2075 (kill-region

2076 (if (bolp) (point) p)

2077 (progn (goto-char q)

2078 (forward-list 1)

2079 (setq r (point))

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

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

2082 tag))))

2083

2084 (defun yahtml-kill-* (whole)

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

2086 (interactive "P")

2087 (cond

2088 ((yahtml-kill-begend whole))))

2089

2090

2091 ;;; ---------- changing ----------

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

2093 "Return if current point is on parameter assignment.

2094 If so, return parameter name, otherwise nil.

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

2096 (let ((p (point)))

2097 (save-excursion

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

2099 (skip-chars-backward "^ \t\n")

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

2101 (< p (match-end 0))

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

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

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

2105 (YaTeX-match-string 1)))))

2106

2107 (defun yahtml-change-begend ()

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

2109 (completion-ignore-case t)

2110 (case-fold-search t)

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

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

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

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

2115 href b1 e1 attr new css)

2116 (cond

2117 (tag

2118 (cond

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

2120 (save-excursion

2121 (and

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

2123 (progn

2124 (goto-char (match-end 0))

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

2126 (setq b1 (point))

2127 (search-forward ">" nil t))

2128 (setq e1 (match-beginning 0))

2129 (goto-char b1)

2130 (re-search-forward "href\\s *=" e1 t)

2131 (>= p (point))

2132 (progn

2133 (goto-char (match-end 0))

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

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

2136 (< p (match-end 0)))))

2137 (setq b1 (match-beginning 1) e1 (match-end 1)

2138 yahtml-completing-buffer (current-buffer)

2139 ;; yahtml-urls-local is buffer-local, so we must put

2140 ;; that into yahtml-urls here

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

2142 href (read-from-minibuffer

2143 "Change href to: " "" yahtml-url-completion-map))

2144 (if (string< "" href)

2145 (progn

2146 ;;(setq href ;??

2147 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2148 (delete-region b1 e1)

2149 (goto-char b1)

2150 (insert href))))

2151 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2152 (if (and (equal attr "class") ;treat "class" attribute specially

2153 (setq css (yahtml-css-get-element-completion-alist tag)))

2154

2155 (setq new (yahtml-read-css css tag))

2156 ;;other than "class", read parameter normally

2157 (setq new (yahtml-read-parameter attr)))

2158 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2159 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2160 (insert new))

2161 (t

2162 (save-excursion

2163 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2164 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2165 (skip-chars-forward "^A-Za-z")

2166 (set-marker q (point))

2167 (setq p (point))

2168 (yahtml-goto-corresponding-begend)

2169 (or (= (char-after (point)) ?<)

2170 (skip-chars-backward "^<"))

2171 (skip-chars-forward "^A-Za-z")

2172 (if (= (char-after (1- (point))) ?/)

2173 (progn

2174 (set-marker q (point))

2175 (goto-char p)))

2176 (setq tag (let ((completion-ignore-case t))

2177 (YaTeX-cplread-with-learning

2178 (format "Change `%s' to(default %s): "

2179 tag yahtml-last-begend)

2180 'default 'user 'tmp)))

2181 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2182 (if (string= "" tag) (setq tag yahtml-last-begend))

2183 (setq yahtml-last-begend

2184 (or (cdr (assoc tag yahtml-env-table)) tag)

2185 tag yahtml-last-begend)

2186 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2187 (insert (format "%s%s" tag (yahtml-addin tag)))

2188 (goto-char q)

2189 (set-marker q nil)

2190 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2191 (insert tag))))

2192 t))))

2193

2194 (defun yahtml-change-command ()

2195 (let ((p (point)) (case-fold-search t) cmd par new

2196 (beg (make-marker)) (end (make-marker)))

2197 (skip-chars-backward "^<")

2198 (if (and

2199 (looking-at yahtml-command-regexp)

2200 (progn

2201 (set-marker beg (match-beginning 0))

2202 (set-marker end (match-end 0))

2203 t) ;for further work

2204 (progn

2205 (forward-char -1)

2206 (condition-case nil

2207 (forward-list 1)

2208 (error nil))

2209 (< p (point))))

2210 (progn

2211 (goto-char p)

2212 (if (setq par (yahtml-on-assignment-p))

2213 (progn

2214 (setq new (yahtml-read-parameter par))

2215 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2216 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2217 (setq new

2218 (YaTeX-cplread-with-learning

2219 "Change form to: "

2220 'yahtml-form-table 'yahtml-user-form-table

2221 'yahtml-tmp-form-table)))

2222 (delete-region beg end)

2223 (goto-char beg)

2224 (set-marker beg nil)

2225 (set-marker end nil)

2226 (insert new)

2227 t)

2228 (goto-char p)

2229 nil)))

2230

2231 (defun yahtml-change-* ()

2232 "Change current position's HTML tag (set)."

2233 (interactive)

2234 (cond

2235 ((yahtml-change-begend))

2236 ((yahtml-change-command))))

2237

2238 ;;; ---------- commenting ----------

2239

2240 (defun yahtml-comment-region (&optional uncom)

2241 "Comment out region or environment."

2242 (interactive)

2243 (let ((e (make-marker)) be beg p)

2244 (cond

2245 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2246 (setq be (yahtml-on-begend-p))

2247 (save-excursion

2248 (setq p (point))

2249 (if (string-match "^/" be)

2250 (setq beg (progn (forward-line 1) (point)))

2251 (setq beg (progn (beginning-of-line) (point))))

2252 (goto-char p)

2253 (yahtml-goto-corresponding-begend)

2254 (if (string-match "^/" be)

2255 (beginning-of-line)

2256 (forward-line 1))

2257 (set-marker e (point))

2258 ;(comment-region beg (point) (if uncom (list 4)))))

2259 ))

2260 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2261 (setq beg (region-beginning))

2262 (set-marker e (region-end))))

2263 (if yahtml-translate-hyphens-when-comment-region

2264 (let ((yahtml-entity-reference-chars-alist-default nil)

2265 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2266 yahtml-entity-reference-chars-regexp

2267 yahtml-entity-reference-chars-reverse-regexp)

2268 (yahtml-entity-reference-chars-setup)

2269 (funcall

2270 (if uncom 'yahtml-translate-reverse-region

2271 'yahtml-translate-region)

2272 beg e)))

2273 (comment-region beg e (if uncom (list 4)))

2274 (set-marker e nil)))

2275

2276 (defun yahtml-uncomment-region ()

2277 (interactive)

2278 (yahtml-comment-region t))

2279

2280 ;;; ---------- translate to entity references ----------

2281 (defvar yahtml-entity-reference-chars-alist-default

2282 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2283 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2284 "Default translation table from character to entity reference")

2285 (defvar yahtml-entity-reference-chars-alist nil

2286 "*Translation table from character to entity reference")

2287 (defvar yahtml-entity-reference-chars-regexp nil)

2288 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2289

2290 (defun yahtml-entity-reference-chars-setup ()

2291 (let ((list (append yahtml-entity-reference-chars-alist-default

2292 yahtml-entity-reference-chars-alist)))

2293 (setq yahtml-entity-reference-chars-regexp "["

2294 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2295 (while list

2296 (setq yahtml-entity-reference-chars-regexp

2297 (concat yahtml-entity-reference-chars-regexp

2298 (char-to-string (car (car list))))

2299 yahtml-entity-reference-chars-reverse-regexp

2300 (concat yahtml-entity-reference-chars-reverse-regexp

2301 (cdr (car list))

2302 (if (cdr list) "\\|")))

2303 (setq list (cdr list)))

2304 (setq yahtml-entity-reference-chars-regexp

2305 (concat yahtml-entity-reference-chars-regexp "]")

2306 yahtml-entity-reference-chars-reverse-regexp

2307 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2308

2309 (yahtml-entity-reference-chars-setup)

2310

2311 (defun yahtml-translate-region (beg end)

2312 "Translate inhibited literals."

2313 (interactive "r")

2314 (save-excursion

2315 (save-restriction

2316 (narrow-to-region beg end)

2317 (let ((ct (append yahtml-entity-reference-chars-alist

2318 yahtml-entity-reference-chars-alist-default)))

2319 (goto-char beg)

2320 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2321 ;(setq c (preceding-char))

2322 (replace-match

2323 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2324

2325 (defun yahtml-translate-reverse-region (beg end)

2326 "Translate entity references to literals."

2327 (interactive "r")

2328 (save-excursion

2329 (save-restriction

2330 (narrow-to-region beg end)

2331 (let ((ct (append yahtml-entity-reference-chars-alist

2332 yahtml-entity-reference-chars-alist-default))

2333 ec)

2334 (goto-char beg)

2335 (while (re-search-forward

2336 yahtml-entity-reference-chars-reverse-regexp nil t)

2337 ;(setq c (preceding-char))

2338 (setq ec (YaTeX-match-string 1))

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

2340 (insert (car (YaTeX-rassoc ec ct))))))))

2341

2342 (defun yahtml-inner-environment-but (exclude &optional quick)

2343 "Return the inner environment but matches with EXCLUDE tag."

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

2345 (save-excursion

2346 (while (and (setq e (YaTeX-inner-environment quick))

2347 (string-match exclude e))

2348 (goto-char (get 'YaTeX-inner-environment 'point))))

2349 e))

2350

2351 (defun yahtml-untranslate-string (str)

2352 "Untranslate entity reference."

2353 (let ((md (match-data)) (left "") (right str) b0 ch

2354 (ct (append yahtml-entity-reference-chars-alist

2355 yahtml-entity-reference-chars-alist-default))

2356 (revrex yahtml-entity-reference-chars-reverse-regexp))

2357 (unwind-protect

2358 (progn

2359 (while (string< "" right)

2360 (cond

2361 ((string-match revrex right)

2362 (setq ch (YaTeX-rassoc

2363 (substring right (match-beginning 1) (match-end 1)))

2364 b0 (substring right 0 (match-beginning 0))

2365 right (substring right (match-end 0))

2366 left (concat left

2367 (substring right 0 (match-beginning 0))

2368 (char-to-string ch))))

2369 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2370 (setq ch (substring right (match-beginning 2) (match-end 2))

2371 b0 (substring right 0 (match-beginning 0))

2372 right (substring right (match-end 0))

2373 left (concat left

2374 b0

2375 (char-to-string

2376 (if (match-beginning 1)

2377 (YaTeX-hex ch)

2378 (string-to-number ch))))))

2379 (t (setq left (concat left right)

2380 right ""))))

2381 left)

2382 (store-match-data md))))

2383

2384 ;;; ---------- table-ize region ----------

2385 (defun yahtml-td-region (e delim beg end)

2386 "Enclose each item in a region with <td>..</td>.

2387 Interactive prefix argument consults enclosing element other than td."

2388 (interactive "P\nsDelimiter(s): \nr")

2389 (let ((e (cond

2390 ((null e) "td")

2391 ((stringp e) e)

2392 (t (read-string-with-history

2393 "Enclose with(`thd' means th td td..): " "th"))))

2394 (ws "[ \t]")

2395 elm p i)

2396 (if (string= delim "") (setq delim " \t\n"))

2397 (setq delim (concat "[" delim "]+")

2398 elm (if (string= "thd" e)

2399 (cons "th" "td")

2400 (cons e e)))

2401 (save-excursion

2402 (save-restriction

2403 (narrow-to-region beg end)

2404 (goto-char (setq p (point-min)))

2405 (setq i 0 e (car elm))

2406 (while (re-search-forward delim nil t)

2407 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

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

2409 (insert "</" e ">")

2410 (save-excursion

2411 (goto-char p)

2412 (insert "<" e ">"))

2413 (setq p (point))

2414 (while (and (not (eobp)) (looking-at ws))

2415 (delete-char 1))

2416 (if (looking-at delim) (delete-char 1)))

2417 (insert "<" e ">")

2418 (goto-char (point-max))

2419 (insert "</" e ">")))))

2420

2421 (defun yahtml-tr-region (e delim beg end)

2422 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2423 (interactive "P\nsDelimiter(s): \nr")

2424 (setq e (if (and e (listp e))

2425 (read-string-with-history

2426 "Enclose with(td or th, `thd' -> th td td td...: " "th")))

2427 (save-excursion

2428 (save-restriction

2429 (narrow-to-region (point) (mark))

2430 (goto-char (point-min))

2431 (while (not (eobp))

2432 (insert "<tr>")

2433 (yahtml-td-region e delim (point) (point-end-of-line))

2434 (end-of-line)

2435 (insert "</tr>")

2436 (forward-line 1)))))

2437

2438 ;;; ---------- filling ----------

2439 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2440 (defun yahtml-move-to-column (col &optional force)

2441 (beginning-of-line)

2442 (let ((ccol 0))

2443 (while (and (> col ccol) (not (eolp)))

2444 (if (eq (following-char) ?\<)

2445 (progn

2446 (while (and (not (eq (following-char) ?\>))

2447 (not (eolp)))

2448 (forward-char))

2449 (or (eolp) (forward-char)))

2450 (or (eolp) (forward-char))

2451 (if (eq (preceding-char) ?\t)

2452 (let ((wd (- 8 (% (+ ccol 8) 8))))

2453 (if (and force (< col (+ ccol wd)))

2454 (progn

2455 (backward-char 1)

2456 (insert-char ?\ (- col ccol))

2457 (setq ccol col))

2458 (setq ccol (+ ccol wd))))

2459 (setq ccol (1+ ccol)))

2460 (if (and YaTeX-japan

2461 (or

2462 (and (fboundp 'char-category)

2463 (string-match "[chj]" (char-category (preceding-char))))

2464 (and (fboundp 'char-charset)

2465 (not (eq (char-charset (preceding-char)) 'ascii)))))

2466 (setq ccol (1+ ccol)))))

2467 (if (and force (> col ccol))

2468 (progn

2469 (insert-char ?\ (- col ccol))

2470 col)

2471 ccol)))

2472

2473 (defun yahtml-fill-paragraph (arg)

2474 (interactive "P")

2475 (let*((case-fold-search t) (p (point)) fill-prefix

2476 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2477 indent

2478 (startp (get 'YaTeX-inner-environment 'point))

2479 (prep (string-match "^pre$" e))

2480 (ps1 (if prep (default-value 'paragraph-start)

2481 paragraph-start))

2482 (ps2 (if prep (concat (default-value 'paragraph-start)

2483 "$\\|^\\s *</?pre>")

2484 paragraph-start)))

2485 (save-excursion

2486 (unwind-protect

2487 (progn

2488 (if prep

2489 (fset 'move-to-column 'yahtml-move-to-column))

2490 (save-excursion

2491 (beginning-of-line)

2492 (indent-to-column (yahtml-this-indent))

2493 (setq fill-prefix

2494 (buffer-substring (point) (point-beginning-of-line)))

2495 (delete-region (point) (point-beginning-of-line)))

2496 (fill-region-as-paragraph

2497 (progn (re-search-backward paragraph-start nil t)

2498 (or (save-excursion

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

2500 (if (looking-at "<")

2501 (forward-list)

2502 (goto-char (match-end 0))

2503 (skip-chars-forward " \t>"))

2504 (if (looking-at "[ \t]*$")

2505 (progn (forward-line 1) (point))))

2506 (point)))

2507 (progn (goto-char p)

2508 (re-search-forward ps2 nil t)

2509 (match-beginning 0))))

2510 (fset 'move-to-column yahtml-saved-move-to-column)))))

2511

2512 ;;;

2513 ;;; ---------- move forward/backward field ----------

2514 ;;;

2515 (defun yahtml-element-path ()

2516 "Return the element path from <body> at point as a list"

2517 (let (path elm)

2518 (save-excursion

2519 (while (and (YaTeX-beginning-of-environment)

2520 (looking-at (concat "<\$" yahtml-command-regexp "\$\\>"))

2521 (not (string= (setq elm (downcase (YaTeX-match-string 1)))

2522 "body")))

2523 (setq path (cons elm path)

2524 elm nil))

2525 (and elm (setq path (cons elm path))))))

2526

2527 (defun yahtml-forward-field (arg)

2528 "Move ARGth forward cell to table element.

2529 ENVINFO is a cons of target element name and its beginning point."

2530 (interactive "p")

2531 (let (inenv elm path sibs)

2532 (cond

2533 ((< arg 0) (yahtml-backward-field (- arg)))

2534 ((= arg 0) nil)

2535 ((and (setq path (nreverse (yahtml-element-path)))

2536 (catch 'sibling

2537 (while path

2538 (if (setq elm (car-safe

2539 (member (car path) '("td" "th" "li" "dt" "dd"))))

2540 (throw 'sibling elm))

2541 (setq path (cdr path)))))

2542 (setq inenv (YaTeX-in-environment-p elm)

2543 sibs (cdr (assoc elm '(("td" . "td\\|th")

2544 ("th" . "td\\|th")

2545 ("li" . "li")

2546 ("dt" . "dt\\|dd")

2547 ("dd" . "dt\\|dd")))))

2548 (goto-char (cdr inenv))

2549 (while (>= (setq arg (1- arg)) 0)

2550 (yahtml-goto-corresponding-begend)

2551 (if (looking-at "<") (forward-list 1))

2552 (skip-chars-forward "^<"))

2553 (while (looking-at "\\s \\|\$</\$")

2554 (if (match-beginning 1) (forward-list 1)

2555 (skip-chars-forward "\n\t ")))

2556 (forward-list 1) ;; step into environment

2557 (skip-chars-forward " \t\n")

2558 (if (looking-at (concat "<\$" sibs "\$\\>"))

2559 (forward-list 1))

2560 ))))

2561

2562

2563 ;;;

2564 ;;; ---------- indentation ----------

2565 ;;;

2566 (defun yahtml-indent-line-1 ()

2567 "Indent a line (faster wrapper)"

2568 (interactive)

2569 (let (indent)

2570 (if (and (save-excursion

2571 (beginning-of-line) (skip-chars-forward "\t ")

2572 (not (looking-at "<")))

2573 (save-excursion

2574 (forward-line -1)

2575 (while (and (not (bobp)) (looking-at "^\\s *$"))

2576 (forward-line -1))

2577 (skip-chars-forward "\t ")

2578 (setq indent (current-column))

2579 (not (looking-at "<"))))

2580 (progn

2581 (save-excursion

2582 (beginning-of-line)

2583 (skip-chars-forward " \t")

2584 (or (= (current-column) indent)

2585 (YaTeX-reindent indent)))

2586 (and (bolp) (skip-chars-forward " \t")))

2587 (yahtml-indent-line-real))))

2588

2589 (defun yahtml-indent-line ()

2590 "Indent a line (Second level wrapper).

2591 See also yahtml-indent-line-1 and yahtml-indent-line-real."

2592 (interactive)

2593 (let ((cc (current-column)) (p (point)))

2594 (yahtml-indent-line-1)

2595 (and (= cc (current-column))

2596 (= p (point))

2597 (equal last-command 'yahtml-indent-line)

2598 (yahtml-forward-field 1))))

2599

2600

2601 (defun yahtml-this-indent ()

2603 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2604 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2605 (excludes

2606 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2607 inenv p col peol (case-fold-search t))

2608 (save-excursion

2609 (beginning-of-line)

2610 (setq inenv (or (yahtml-inner-environment-but excludes t)

2611 "html")

2612 col (get 'YaTeX-inner-environment 'indent)

2613 p (get 'YaTeX-inner-environment 'point)

2614 op nil))

2615 (save-excursion

2616 (cond

2617 ((string-match (concat "^\$" envs "\$") inenv)

2618 (save-excursion

2619 (beginning-of-line)

2620 (skip-chars-forward " \t")

2621 (cond ;lookup current line's tag

2622 ((looking-at (concat "</\$" envs "\$>"))

2623 col)

2624 ((looking-at itms)

2625 (+ col yahtml-environment-indent))

2626 ((and yahtml-hate-too-deep-indentation

2627 (looking-at (concat "<\$" envs "\$")))

2628 (+ col (* 2 yahtml-environment-indent)))

2629 ((and (< p (point))

2630 (string-match itemizing-envs inenv)

2631 (save-excursion

2632 (and

2633 (setq op (point))

2634 (goto-char p)

2635 (re-search-forward itms op t)

2636 (progn

2637 (if yahtml-indent-listing-constant

2638 (setq col (+ (current-column)

2639 (if yahtml-faithful-to-htmllint 1 2)))

2640 (skip-chars-forward "^>")

2641 (skip-chars-forward ">")

2642 (skip-chars-forward " \t")

2643 (setq col (if (looking-at "$")

2644 (+ col yahtml-environment-indent)

2645 (current-column))))))))

2646 col)

2647 (t

2648 (+ col yahtml-environment-indent)))))

2649 (t col)))))

2650

2651 (defun yahtml-indent-line-real ()

2652 "Indent current line."

2653 (interactive)

2654 (YaTeX-reindent (yahtml-this-indent))

2655 (if (bolp) (skip-chars-forward " \t"))

2656 (let (peol col inenv)

2657 (if (and (setq inenv (yahtml-on-begend-p))

2658 (string-match

2659 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2660 (save-excursion

2661 (setq peol (point-end-of-line))

2662 (or (= (char-after (point)) ?<)

2663 (progn (skip-chars-backward "^<") (forward-char -1)))

2664 (setq col (current-column))

2665 (if (and (yahtml-goto-corresponding-begend t)

2666 (> (point) peol)) ;if on the different line

2667 (YaTeX-reindent col))))))

2668

2669 ;(defun yahtml-fill-item ()

2670 ; "Fill item HTML version"

2671 ; (interactive)

2672 ; (let (inenv p fill-prefix peol (case-fold-search t))

2673 ; (setq inenv (or (YaTeX-inner-environment) "html")

2674 ; p (get 'YaTeX-inner-environment 'point))

2675 ; (cond

2676 ; ((string-match "^[uod]l" inenv)

2677 ; (save-excursion

2678 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2679 ; (progn

2680 ; (goto-char (match-end 0))

2681 ; (setq col (current-column)))

2682 ; (error "No <li>, <dt>, <dd>")))

2683 ; (save-excursion

2684 ; (end-of-line)

2685 ; (setq peol (point))

2686 ; (newline)

2687 ; (indent-to-column col)

2688 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2689 ; (delete-region (point) peol)

2690 ; (fill-region-as-paragraph

2691 ; (progn (re-search-backward paragraph-start nil t) (point))

2692 ; (progn (re-search-forward paragraph-start nil t 2)

2693 ; (match-beginning 0)))))

2694 ; (t nil))))

2695

2696 ;;;

2697 ;;; ---------- Lint and Browsing ----------

2698 ;;;

2699 (defun yahtml-browse-menu ()

2700 "Browsing or other external process invokation menu."

2701 (interactive)

2702 (message "J)weblint p)Browse R)eload N)ewpage...")

2703 (let ((c (char-to-string (read-char))))

2704 (cond

2705 ((string-match "j" c)

2706 (yahtml-lint-buffer (current-buffer)))

2707 ((string-match "[bp]" c)

2708 (yahtml-browse-current-file))

2709 ((string-match "r" c)

2710 (yahtml-browse-reload))

2711 ((string-match "n" c)

2712 (call-interactively 'yahtml-newpage)))))

2713

2714 (if (fboundp 'wrap-function-to-control-ime)

2715 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2716

2717 (defvar yahtml-lint-buffer "*weblint*")

2718

2719 (defun yahtml-lint-buffer (buf)

2720 "Call lint on buffer BUF."

2721 (require 'yatexprc)

2722 (interactive "bCall lint on buffer: ")

2723 (setq buf (get-buffer buf))

2724 (YaTeX-save-buffers)

2725 (let ((bcmd (YaTeX-get-builtin "lint")))

2726 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2727 (YaTeX-typeset

2728 (concat (or bcmd yahtml-lint-program)

2729 " " (file-name-nondirectory (buffer-file-name buf)))

2730 yahtml-lint-buffer "lint" "lint")))

2731

2732 (defun yahtml-file-to-url (file)

2733 "Convert local unix file name to URL.

2734 If no matches found in yahtml-path-url-alist, return raw file name."

2735 (let ((list yahtml-path-url-alist) p url)

2736 (if (file-directory-p file)

2737 (setq file (expand-file-name yahtml-directory-index file))

2738 (setq file (expand-file-name file)))

2739 (if (string-match "^[A-Za-z]:/" file)

2740 (progn

2741 ;; (aset file 1 ?|) ;これは要らないらしい…

2742 (setq file (concat "///" file))))

2743 (while list

2744 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2745 (setq url (cdr (car list))

2746 file (substring file (match-end 0))

2747 url (concat url file)

2748 list nil))

2749 (setq list (cdr list)))

2750 (or url (concat "file:" file))))

2751

2752 (defun yahtml-url-to-path (file &optional basedir)

2753 "Convert local URL name to unix file name."

2754 (let ((list yahtml-path-url-alist) url realpath docroot

2755 (dirsufp (string-match "/$" file)))

2756 (setq basedir (or basedir

2757 (file-name-directory

2758 (expand-file-name default-directory))))

2759 (cond

2760 ((string-match "^/" file)

2761 (while list

2762 (if (file-directory-p (car (car list)))

2763 (progn

2764 (setq url (cdr (car list)))

2765 (if (string-match "\$http://[^/]*\$/" url)

2766 (setq docroot (substring url (match-end 1)))

2767 (setq docroot url))

2768 (cond

2769 ((string-match (concat "^" (regexp-quote docroot)) file)

2770 (setq realpath

2771 (expand-file-name

2772 (substring

2773 file

2774 (if (= (aref file (1- (match-end 0))) ?/)

2775 (match-end 0) ; "/foo"

2776 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2777 (car (car list))))))

2778 (if realpath

2779 (progn (setq list nil)

2780 (if (and dirsufp (not (string-match "/$" realpath)))

2781 (setq realpath (concat realpath "/")))))))

2782 (setq list (cdr list)))

2783 realpath)

2784 (t file))))

2785

2786 (defun yahtml-browse-current-file ()

2787 "Call WWW browser on current file."

2788 (interactive)

2789 (basic-save-buffer)

2790 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2791

2792 (defun yahtml-browse-reload ()

2793 "Send `reload' event to netscape."

2794 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2795 (cond

2796 ((string-match "[Nn]etscape" yahtml-www-browser)

2797 (if (get-buffer pb)

2798 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2799 ;;(or (get 'yahtml-netscape-sentinel 'url)

2800 ;; (error "Reload should be called after Browsing."))

2801 (put 'yahtml-netscape-sentinel 'url

2802 (yahtml-file-to-url (buffer-file-name)))

2803 (basic-save-buffer)

2804 (set-process-sentinel

2805 (setq yahtml-browser-process

2806 (start-process

2807 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2808 (format "%s -remote 'reload'" yahtml-www-browser)))

2809 'yahtml-netscape-sentinel))

2810 (t

2811 (message "Sorry, RELOAD is supported only for Netscape.")))))

2812

2813 ;;; ---------- Intelligent newline ----------

2814 (defun yahtml-intelligent-newline (arg)

2815 "Intelligent newline for HTML"

2816 (interactive "P")

2817 (let (env func)

2818 (end-of-line)

2819 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2820 "html")))

2821 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2822 (newline)

2823 (if (and env func (fboundp func))

2824 ;; if intelligent line function is defined, call that

2825 (funcall func)

2826 ;; else do the default action

2827 (if (string-match yahtml-p-prefered-env-regexp env)

2828 (yahtml-insert-p)))))

2829

2830 (defun yahtml-intelligent-newline-ul ()

2831 (interactive)

2832 (yahtml-insert-single "li")

2833 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2834 (yahtml-indent-line))

2835

2836 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2837

2838 (defun yahtml-intelligent-newline-dl ()

2839 (interactive)

2840 (let ((case-fold-search t))

2841 (if (save-excursion

2842 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2843 (get 'YaTeX-inner-environment 'point) t))

2844 (cond

2845 ((match-beginning 2)

2846 (yahtml-insert-single "dd")

2847 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2848 (setq yahtml-last-single-cmd "dt"))

2849 ((match-beginning 3)

2850 (yahtml-insert-single "dt")

2851 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2852 (setq yahtml-last-single-cmd "dd")))

2853 (yahtml-insert-single "dt")

2854 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2855 (setq yahtml-last-single-cmd "dd"))

2856 (yahtml-indent-line)

2857 (and (string-match yahtml-p-prefered-env-regexp "dl")

2858 (string-equal yahtml-last-single-cmd "dt")

2859 (yahtml-insert-p nil))))

2860

2861 (defun yahtml-intelligent-newline-select ()

2862 (interactive)

2863 (yahtml-insert-single (if yahtml-prefer-upcases "OPTION" "option"))

2864 (yahtml-indent-line))

2865

2866 (defun yahtml-intelligent-newline-style ()

2867 (interactive)

2868 (if (save-excursion

2869 (and

2870 (re-search-backward "<style\\|<!-- " nil t)

2871 (looking-at "<style")))

2872 (let (c)

2873 (yahtml-indent-line)

2874 (setq c (current-column))

2875 (insert "<!--\n")

2876 (YaTeX-reindent c)

2877 (insert "-->")

2878 (beginning-of-line)

2879 (open-line 1)

2880 (YaTeX-reindent c))))

2881

2882 (defun yahtml-intelligent-newline-head ()

2883 (let ((title (read-string-with-history "Document title: "))

2884 (b "<title>") (e "</title>") p)

2885 (yahtml-indent-line)

2886 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2887 (setq p (point))

2888 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2889 (if (string= "" title) (goto-char p))

2890 (setq yahtml-last-begend "body")))

2891

2892 (defun yahtml-intelligent-newline-script ()

2893 (let ((p (point)) b)

2894 (if (save-excursion

2895 (and

2896 (setq b (re-search-backward "<script\\>" nil t))

2897 (re-search-forward

2898 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2899 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2900 c (srcp (re-search-backward "src=" b t)))

2901 (goto-char p)

2902 (yahtml-indent-line)

2903 (setq c (current-column))

2904 (if srcp

2905 nil

2906 (insert "")

2907 (beginning-of-line)

2908 (open-line 1)

2909 (YaTeX-reindent c))))))

2910

2911 (defun yahtml-intelligent-newline-table ()

2912 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2913 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2914 (cond

2915 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2916 (while (and (setq rb (re-search-backward ptn tb t))

2917 (match-beginning 1))

2918 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2919 (goto-char (match-end 0))

2920 (skip-chars-forward " \t\n")

2921 (if (and (search-forward "colspan\\s *=" p t)

2922 (progn

2923 (skip-chars-forward "\"' \t\n")

2924 (looking-at "[0-9]+")))

2925 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2926 (setq cols (1+ cols)))

2927 (goto-char rb)

2928 (setq p (point)))

2929 (if (> cols 0)

2930 (message "%s columns found. %s"

2931 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2932 "New tr?(N) or Duplicate")))

2933 (cond

2934 ((and (> cols 0)

2935 (memq (read-char) '(?d ?D))) ;Duplication mode

2936 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2937 (t ;empty cells

2938 (setq line "<tr>" i 0)

2939 (if (> cols 0)

2940 (while (> cols i)

2941 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2942 "<td></td>"))

2943 th nil i (1+ i)))

2944 (setq fmt (read-string-with-history

2945 "`th' or `td' format: " "th td td"))

2946 (while (string-match "t\$h\$\\|td" fmt i)

2947 (setq line (concat line (if (match-beginning 1) "<th></th>"

2948 "<td></td>"))

2949 i (match-end 0))))

2950 (setq line (concat line "</tr>"))))

2951 (goto-char cp)

2952 (if th

2953 (message

2954 "Type `%s' to change td from/to th."

2955 (key-description (car (where-is-internal 'yahtml-change-*)))))

2956 (if (string< "" line)

2957 (progn

2958 (insert line)

2959 (goto-char (+ 8 cp))

2960 (yahtml-indent-line)))))))

2961

2962 ;;; ---------- Marking ----------

2963 (defun yahtml-mark-begend ()

2964 "Mark current tag"

2965 (interactive)

2966 (YaTeX-beginning-of-environment)

2967 (let ((p (point)))

2968 (save-excursion

2969 (skip-chars-backward " \t" (point-beginning-of-line))

2970 (if (bolp) (setq p (point))))

2971 (push-mark p t))

2972 (yahtml-goto-corresponding-begend)

2973 (forward-list 1)

2974 (if (eolp) (forward-char 1)))

2975

2976 ;;; ---------- complete marks ----------

2977 (defun yahtml-complete-mark ()

2978 "Complete &gt, &lt, &ampersand, and &quote."

2979 (interactive)

2980 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2981 (let ((c (read-char)))

2982 (setq c (if (or (< c ?0) (> c ?7))

2983 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2984 (- c ?1)))

2985 (if (or (< c 0) (> c 6))

2986 nil

2987 (insert (format "&%s;"

2988 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2989

2990

2991 ;;; ---------- jump to error line ----------

2992 (defun yahtml-prev-error ()

2993 "Jump to previous error seeing lint buffer."

2994 (interactive)

2995 (or (get-buffer yahtml-lint-buffer)

2996 (error "No lint program ran."))

2997 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2998 (yahtml-jump-to-error-line t))

2999

3000 (defun yahtml-jump-to-error-line (&optional sit)

3001 (interactive "P")

3002 (let ((p (point)) (e (point-end-of-line)))

3003 (end-of-line)

3004 (if (re-search-backward yahtml-error-line-regexp nil t)

3005 (let ((f (if (string= "" (YaTeX-match-string 1))

3006 YaTeX-current-file-name

3007 (YaTeX-match-string 1)))

3008 (l (string-to-int (or (YaTeX-match-string 2)

3009 (YaTeX-match-string 3)))))

3010 (if sit (sit-for 1))

3011 (forward-line -1)

3012 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

3013 (goto-line l))

3014 (message "No line number usage"))))

3015

3016 ;;; ---------- Style Sheet Support ----------

3017 (defvar yahtml-css-class-alist nil

3018 "Alist of elements vs. their classes")

3019

3020 (defun yahtml-css-collect-classes-region (beg end &optional initial)

3021 (save-excursion

3022 (save-restriction

3023 (narrow-to-region beg end)

3024 (goto-char (point-min))

3025 (let ((alist initial) b e element class a)

3026 (setq b (point))

3027 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

3028 (if (match-beginning 2)

3029 (let ((f (YaTeX-buffer-substring

3030 (progn (skip-chars-forward "^\"")(1+ (point)))

3031 (progn (forward-char 1)

3032 (skip-chars-forward "^\"")(point)))))

3033 (if (file-exists-p f)

3034 (setq alist

3035 (append alist (yahtml-css-collect-classes-file

3036 f initial)))))

3037 (setq e (point))

3038 (goto-char b)

3039 (while (re-search-forward ;ちょといい加減なREGEXP

3040 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

3041 e t)

3042 (setq element (YaTeX-match-string 1)

3043 class (YaTeX-match-string 2))

3044 ;;if starts with period (match-string 1 is nil),

3045 ;;this is global class

3046 (setq element (downcase (or element "*")))

3047 (if (setq a (assoc element alist))

3048 (or (assoc class (cdr a))

3049 (setcdr a (cons (list class) (cdr a))))

3050 (setq alist (cons (list element (list class)) alist))))

3051 (goto-char (1- e))

3052 (search-forward "}" nil 1) ;1=move to limit when not found.

3053 (setq b (point))))

3054 alist))))

3055

3056 (defun yahtml-css-collect-classes-buffer (&optional initial)

3057 (interactive)

3058 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

3059

3060 (defun yahtml-css-collect-classes-file (file &optional initial)

3061 (let*((hilit-auto-highlight nil)

3062 (buf (get-buffer-create

3063 (format " *css-collection*%s" (file-name-nondirectory file))))

3064 (cb (current-buffer)))

3065 (unwind-protect

3066 (progn

3067 (set-buffer buf)

3068 (insert-file-contents file)

3069 (cd (or (file-name-directory file) "."))

3070 (yahtml-css-collect-classes-buffer initial))

3071 (if (eq buf cb)

3072 nil

3073 (kill-buffer buf)

3074 (set-buffer cb)))))

3075

3076 (defun yahtml-css-scan-styles ()

3077 (save-excursion

3078 (goto-char (point-min))

3079 (set (make-local-variable 'yahtml-css-class-alist) nil)

3080 (let (b tag type e href alist)

3081 (while (re-search-forward "<\$style\\|link\$" nil t)

3082 (setq b (match-beginning 0)

3083 tag (YaTeX-match-string 1))

3084 (cond

3085 ((string-match "style" tag)

3086 (goto-char b)

3087 (save-excursion (forward-list 1) (setq e (point)))

3088 (cond

3089 ((search-forward "text/css" e 1) ;css definition starts

3090 (setq alist

3091 (yahtml-css-collect-classes-region

3092 (point) (progn (search-forward "</style>") (point))

3093 alist)))))

3094 ((and (string-match "link" tag)

3095 (stringp (setq type (yahtml-get-attrvalue "type")))

3096 (string-match "text/css" type)

3097 (setq href (yahtml-get-attrvalue "href"))

3098 (file-exists-p (yahtml-url-to-path href)))

3099 (setq alist

3100 (yahtml-css-collect-classes-file

3101 (yahtml-url-to-path href) alist))))

3102 (setq yahtml-css-class-alist alist)))))

3103

3104 (defun yahtml-css-get-element-completion-alist (element)

3105 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3106 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3107 (and (or alist global)

3108 (append alist global))))

3109

3110 ;;; ---------- ----------

3111

3112 ;;;

3113 ;;hilit19

3114 ;;;

3115 (defvar yahtml-default-face-table

3116 '(

3117 (form black/ivory white/hex-442233 italic)

3118 ))

3119 (defvar yahtml-hilit-patterns-alist

3120 '(

3121 'case-fold

3122 ;; comments

3123 ("" comment)

3124 ;; include&exec

3125 ("" include)

3126 ;; string

3127 (hilit-string-find ?\\ string)

3128 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3129 ("</?[uod]l>" 0 decl)

3130 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3131 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3132 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3133 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3134 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3135 ))

3136

3137 (defun yahtml-hilit-region-tag (tag)

3138 "Return list of start/end point of <TAG> form."

3139 (if (re-search-forward tag nil t)

3140 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3141 (elm (YaTeX-match-string 1)))

3142 (skip-chars-forward "^>")

3143 (prog1

3144 (cons (1+ (point))

3145 (progn (re-search-forward (concat "</" elm ">") nil t)

3146 (match-beginning 0)))

3147 (goto-char e0)))))

3148

3149 (defun yahtml-hilit-region-tag-itself (ptn)

3150 "Return list of start/end point of <tag options...> itself."

3151 (if (re-search-forward ptn nil t)

3152 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3153 (skip-chars-forward "^<>")

3154 (if (eq (char-after (point)) ?<) nil

3155 (prog1

3156 (cons m0 (min (point-max) (1+ (point))))

3157 (goto-char e0))))))

3158

3159 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3160 (and yahtml-use-hilit19

3161 (or (assq 'yahtml-mode hilit-patterns-alist)

3162 (setq hilit-patterns-alist

3163 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3164 hilit-patterns-alist))))

3165 ;;;

3166 ;; for font-lock

3167 ;;;

3168

3169 ; <<STATIC KEYWORDS BELOW NOT USED>>

3170 ;(defvar yahtml-font-lock-keywords

3171 ; '(

3172 ; ;; comments

3173 ; ("" . font-lock-comment-face)

3174 ; ;; include&exec

3175 ; (""

3176 ; 0 font-lock-include-face keep)

3177 ; ;; string

3178 ; ;(hilit-string-find ?\\ string)

3179 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3180 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3181 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3182 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3183 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3184 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3185 ; )

3186 ; "*Defualt font-lock-keywords for yahtml-mode.")

3187 (defvar yahtml-font-lock-keywords

3188 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3189 "Default fontifying patterns for yahtml-mode")

3190

3191 (defun yahtml-font-lock-set-default-keywords ()

3192 (put 'yahtml-mode 'font-lock-defaults

3193 '(yahtml-font-lock-keywords nil t)))

3194

3195 (if yahtml-use-font-lock

3196 (progn

3197 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3198 ;;for those who use both hilit19 and font-lock

3199 (if (eq (car hilit-mode-enable-list) 'not)

3200 (or (member 'yahtml-mode hilit-mode-enable-list)

3201 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3202 (setq hilit-mode-enable-list

3203 (delq 'yahtml-mode hilit-mode-enable-list))))

3204 (yahtml-font-lock-set-default-keywords)))

3205

3206 (defun yahtml-font-lock-recenter (&optional arg)

3207 (interactive "P")

3208 (font-lock-mode -1) ;is stupid, but sure.

3209 (font-lock-mode 1))

3210

3211 ;;;

3212 ;; Drag-n-Drop

3213 ;;;

3214 (defun yahtml-dnd-handler (uri action)

3215 "DnD handler for yahtml mode

3216 Convert image URI to img-src and others to a-href."

3217 (let*((file (dnd-get-local-file-name uri))

3218 (path (if file (file-relative-name file) uri))

3219 (case-fold-search t)

3220 (geom ""))

3221 (cond

3222 ((memq action '(copy link move private))

3223 (cond

3224 ((string-match "\\.\$jpe?g\\|png\\|gif\\|bmp\\|tiff?\$$" path)

3225 (if file

3226 (setq geom (yahtml-get-image-info path)

3227 geom (if (car geom)

3228 (apply 'format " width=\"%s\" height=\"%s\"" geom)

3229 "")))

3230 (insert (format "<img src=\"%s\" alt=\"%s\"%s>"

3231 path (file-name-nondirectory path) geom)))

3232

3233 (t (insert (format "<a href=\"%s\"></a>" path))

3234 (forward-char -4))))

3235 (t (message "No handler for action `%s'" action))))

3236 action)

3237

3238 (run-hooks 'yahtml-load-hook)

3239 (provide 'yahtml)

3240

3241 ; Local variables:

3242 ; fill-prefix: ";;; "

3243 ; paragraph-start: "^$\\|\\|;;;$"

3244 ; paragraph-separate: "^$\\|\\|;;;$"

3245 ; coding: sjis

3246 ; End: