yatex: 2fc714f03ddf yahtml.el

yatex

view yahtml.el @ 396:2fc714f03ddf

Clarify which element the current class name completions for

author	HIROSE Yuuji <yuuji@gentei.org>
date	Fri, 16 Jan 2015 10:47:48 +0900
parents	67fa6d791bc9
children	781604df4cbd

line source

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

3 ;;; Last modified Fri Jan 16 10:44:54 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 ;;; --- customizable variable ends here ---

290 (defvar yahtml-prefix-map nil)

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

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

293 (defvar yahtml-shell-command-option

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

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

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

297

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

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

300 (YaTeX-define-key

301 key

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

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

304 map))

305

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

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

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

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

310

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

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

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

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

315 (if YaTeX-inhibit-prefix-letter nil

316 (yahtml-define-begend-region-key

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

318

319 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

337 (and YaTeX-emacs-19 window-system

338 (progn

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

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

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

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

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

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

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

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

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

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

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

350 (if YaTeX-no-begend-shortcut

351 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

390 (substitute-all-key-definition

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

392 (substitute-all-key-definition

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

394

395 (if yahtml-lint-buffer-map nil

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

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

398

399

400 (defvar yahtml-paragraph-start

401 (concat

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

403 "*Regexp of html paragraph separater")

404 (defvar yahtml-paragraph-separate

405 (concat

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

407 "*Regexp of html paragraph separater")

408 (defvar yahtml-syntax-table nil

409 "*Syntax table for yahtml-mode")

410

411 (if yahtml-syntax-table nil

412 (setq yahtml-syntax-table

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

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

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

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

417

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

419 "Regexp of constituent of html commands.")

420

421 ;;; Completion tables for `form'

422 (defvar yahtml-form-table

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

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

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

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

427

428 (defvar yahtml-env-table

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

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

431 ("OrderedList" . "ol")

432 ("UnorderedList" . "ul")

433 ("DefinitionList" . "dl")

434 ("Preformatted" . "pre")

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

436 ("address") ("button")

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

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

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

440 ("option")

441 ))

442

443 (if yahtml-html4-strict

444 (setq yahtml-env-table

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

446

447 ;(defvar yahtml-itemizing-regexp

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

449 ; "Regexp of itemizing forms")

450

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

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

453

454 ;;; Completion tables for typeface designator

455 (and yahtml-always-/p

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

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

458 (and yahtml-always-/li

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

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

461 (and yahtml-always-/dt

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

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

464 (and yahtml-always-/dd

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

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

467

468 (defvar yahtml-typeface-table

469 (append

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

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

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

473 (if (not yahtml-html4-strict)

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

475 yahtml-env-table)

476 "Default completion table of typeface designator")

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

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

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

480

481 (defvar yahtml-single-cmd-table

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

483 ("HorizontalRule" . "hr")

484 ("BreakLine" . "br")

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

486 ("!--#exec")

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

488 ("!--#include")

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

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

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

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

493 )

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

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

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

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

498

499 (defvar yahtml-current-completion-type nil

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

501

502 (defvar yahtml-struct-name-regexp

503 (concat

504 "\\<\\("

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

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

507 "\\)\\b")

508 "Regexp of structure beginning.")

509

510 (defvar yahtml-closable-regexp

511 (concat

512 "\\<\\("

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

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

515 "\\)\\b")

516 "Regexp of any closable elemnts.")

517

518 (defvar yahtml-indent-listing-constant t

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

520 T for static indentation depth")

521

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

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

524

525

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

527 (cond

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

529 buffer-file-name)

530 (let ((dir default-directory)

531 charset af ext (ldir "")

532 line

533 (case-fold-search t)

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

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

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

537 (while (and dir

538 (not (string= dir ldir))

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

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

541 (if (file-exists-p af)

542 (save-excursion

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

544 (save-excursion

545 (goto-char (point-min))

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

547 (setq line (buffer-substring

548 (point-beginning-of-line)

549 (point-end-of-line))

550 dir nil)))

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

552 (if dir

553 (setq ldir dir

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

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

556 line))

557 (t nil)))

558

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

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

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

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

563 (case-fold-search t)

564 line

565 charset)

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

567 (progn

568 (string-match ptn line)

569 (setq charset

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

571 (cond

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

573 (setq charset 2))

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

575 (setq charset 3))

576 ((string-match "shift_jis" charset)

577 (setq charset 1))

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

579 (setq charset 4))

580 (t (setq charset nil)))

581 (setq dir "")))

582 (if (featurep 'mule)

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

584 charset))

585

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

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

588 x index-list)

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

590 (if line

591 (progn

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

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

594 (while (string< "" line)

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

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

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

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

599 line "")))

600 (or (nreverse index-list)

601 (if (listp yahtml-directory-index)

602 yahtml-directory-index

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

604

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

606 (defun yahtml-mode ()

607 (interactive)

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

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

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

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

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

613 (cond

614 ((null coding) nil)

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

616 (setq buffer-file-coding-system

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

618 (save-excursion

619 (goto-char (point-min))

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

621 coding)))

622 ((featurep 'mule)

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

624 ((boundp 'NEMACS)

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

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

627 (setq major-mode 'yahtml-mode

628 mode-name "yahtml"

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

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

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

632 (mapcar

633 (function (lambda (x)

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

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

636 (boundp (cdr x)))

637 (symbol-value (cdr x))

638 (cdr x)))))

639 '((YaTeX-ec . "")

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

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

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

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

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

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

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

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

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

649 (comment-start . "")

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

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

652

653 (if yahtml-use-font-lock

654 (progn

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

656 (or (featurep 'xemacs)

657 (progn

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

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

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

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

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

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

664 ;; +dnd for X11 w/ emacs23+

665 (and window-system (featurep 'dnd)

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

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

668 dnd-protocol-alist)))

669

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

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

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

673 (yahtml-css-scan-styles)

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

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

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

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

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

679

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

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

682 font-lock-defaults)

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

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

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

686

687 (defun yahtml-version ()

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

689 (interactive)

690 (message

691 (concat "Yet Another HTML-mode "

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

693 " Revision "

694 yahtml-revision-number)))

695

696 (defun yahtml-quit ()

697 (interactive)

698 (and yahtml-mode-old-mode

699 (fboundp yahtml-mode-old-mode)

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

701

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

703 (cond

704 ((featurep 'xemacs)

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

706 (set keymap nil)

707 (mapcar

708 (function

709 (lambda (bind)

710 (setq bind (cdr bind))

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

712 (setcar (cdr bind) 'progn))

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

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

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

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

717 bindlist)

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

719 (t

720 (mapcar

721 (function

722 (lambda (bind)

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

724 bindlist))))

725

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

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

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

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

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

731

732 ;;; Variables for mosaic url history

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

734 (defvar yahtml-urls-private nil)

735 (defvar yahtml-urls-local nil)

736

737 (cond

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

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

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

741 (YaTeX-define-menu

742 'yahtml-menu-map-sectioning

743 (nreverse

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

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

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

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

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

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

750 )))

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

752 (YaTeX-define-menu

753 'yahtml-menu-map-logical

754 (nreverse

755 '((em "Embolden" .

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

757 (dfn "Define a word" .

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

759 (cite "Citation" .

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

761 (code "Code" .

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

763 (kbd "Keyboard" .

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

765 (samp "Sample display" .

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

767 (strong "Strong" .

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

769 (VAR "Variable notation" .

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

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

772 (YaTeX-define-menu

773 'yahtml-menu-map-typeface

774 (nreverse

775 '((b "Bold" .

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

777 (i "Italic" .

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

779 (tt "Typewriter" .

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

781 (u "Underlined" .

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

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

784 (YaTeX-define-menu

785 'yahtml-menu-map-listing

786 (nreverse

787 '((ul "Unordered" .

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

789 (ol "Ordered" .

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

791 (dl "Definition" .

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

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

794 (YaTeX-define-menu

795 'yahtml-menu-map-item

796 (nreverse

797 '((li "Simple item" .

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

799 (dt "Define term" .

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

801 (dd "Description of term" .

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

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

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

805 (YaTeX-define-menu

806 'yahtml-menu-map

807 (nreverse

808 (list

809 (cons (list 'sect "Sectioning")

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

811 (cons (list 'list "Listing")

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

813 (cons (list 'item "Item")

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

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

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

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

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

819 (if (featurep 'xemacs)

820 (add-hook 'yahtml-mode-hook

821 (function

822 (lambda ()

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

824 (progn

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

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

827

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

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

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

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

832 (interactive "P")

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

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

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

836 (cmd

837 (or env

838 (YaTeX-cplread-with-learning

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

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

841 (bolp (save-excursion

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

843 (cc (current-column)))

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

845 (setq yahtml-last-begend

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

847 yahtml-last-begend))

848 (setq cmd yahtml-last-begend)

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

850 (if region

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

852 ;; to enable continuous regioning by another environment

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

854 (end (region-end))

855 (addin (yahtml-addin cmd)))

856 (save-excursion

857 (goto-char end)

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

859 (goto-char beg)

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

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

862 (save-excursion

863 (insert "\n")

864 (indent-to-column cc)

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

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

867 (newline)

868 (yahtml-intelligent-newline nil))

869 (yahtml-indent-line))))

870

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

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

873 (interactive)

874 (yahtml-insert-begend t))

875

876

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

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

879 (interactive)

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

881 (or form

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

883 (setq form

884 (YaTeX-cplread-with-learning

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

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

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

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

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

890 (setq yahtml-last-form form)

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

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

893 ;;(indent-relative-maybe)

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

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

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

897

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

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

900 (minibuffer-completion-table alist)

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

902 (read-from-minibuffer-with-history

903 (if YaTeX-japan

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

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

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

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

908 nil YaTeX-minibuffer-completion-map nil)))

909

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

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

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

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

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

915 (defun yahtml-newpage (file ov)

916 "Create newpage via newpage script"

917 (interactive

918 (list

919 (let (insert-default-directory)

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

921 current-prefix-arg))

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

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

924 (insert (substring

925 (YaTeX-command-to-string

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

927 0 -1)))

928

929 ;;; ---------- Add-in ----------

930 (defun yahtml-addin (form)

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

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

933 (concat

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

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

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

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

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

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

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

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

942 (string< "" s))

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

944 ""))))

945

946 (defvar yahtml-completing-buffer nil)

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

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

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

950 (let (list end)

951 (save-excursion

952 (set-buffer yahtml-completing-buffer)

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

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

955 (save-excursion

956 (goto-char (point-min))

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

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

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

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

961 (setq end (match-end 0))

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

963 (yahtml-on-assignment-p)

964 (progn

965 (goto-char end)

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

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

968 (setq list (cons

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

970 list))))

971 list))))

972

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

974 (if yahtml-url-completion-map nil

975 (setq yahtml-url-completion-map

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

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

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

979

980 (defun yahtml-complete-url ()

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

982 (interactive)

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

984 (lim (YaTeX-minibuffer-begin))

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

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

987 (cond

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

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

990 listfunc (list 'lambda nil

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

992 beg min))

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

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

995 (progn

996 (setq path (substring initial 0 beg))

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

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

999 (setq initial (substring initial beg))

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

1001 cmpl (try-completion initial labels)

1002 listfunc (list 'lambda ()

1003 (list 'all-completions

1004 initial (list 'quote labels)))

1005 beg (+ min beg)))

1006 (t

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

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

1009 initial))

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

1011 file (file-name-nondirectory path)

1012 initial file

1013 cmpl (file-name-completion file dir)

1014 listfunc (list 'lambda nil

1015 (list 'file-name-all-completions

1016 file dir))

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

1018 (cond

1019 ((stringp cmpl)

1020 (if (string= initial cmpl)

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

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

1023 (princ

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

1025 (delete-region (point) beg)

1026 (insert cmpl)))

1027 ((null cmpl)

1028 (ding))

1029 ((eq t cmpl)

1030 (save-excursion

1031 (unwind-protect

1032 (progn

1033 (goto-char p)

1034 (insert " [Sole completion]"))

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

1036

1037 ;

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

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

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

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

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

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

1044 ;

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

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

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

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

1049 (defvar yahtml-unsafe-chars-regexp

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

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

1052 ;

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

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

1055 ;

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

1057 ; "$" | ","

1058 (defvar yahtml-unreserved-chars-regexp

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

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

1061 Not used yet.")

1062

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

1064 "Translate reserved chars to URL encoded string."

1065 (let ((p 0) (target "")

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

1067 (cond

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

1069 (t

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

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

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

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

1074 (setq target (concat target

1075 (substring str 0 p)

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

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

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

1079 (concat target str)))))

1080

1081 (defun yahtml-unescape-string (str)

1082 "Untranslate reserved URL-encoded string."

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

1084 (unwind-protect

1085 (progn

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

1087 (setq target (concat target

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

1089 p (match-end 0)

1090 c (YaTeX-hex (substring

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

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

1093 (concat target (substring str p)))

1094 (store-match-data md))))

1095

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

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

1098 (interactive "r")

1099 (save-excursion

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

1101 (goto-char beg)

1102 (while (and (< (point) e)

1103 (re-search-forward

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

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

1106 (sit-for 0)

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

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

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

1110 ; (unwind-protect

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

1112 ; (save-excursion

1113 ; (backward-char 1)

1114 ; (delete-backward-char 4))

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

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

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

1118 (progn

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

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

1121 (set-marker e nil))))

1122 ;; ab%defgls/.|

1123

1124 (defun yahtml:a ()

1125 "Add-in function for <a>"

1126 (let ((href ""))

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

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

1129 href (yahtml-escape-chars-string

1130 (read-from-minibuffer-with-history

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

1132 (prog1

1133 (concat (yahtml-make-optional-argument

1134 "href" href)

1135 (yahtml-make-optional-argument

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

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

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

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

1140 (YaTeX-update-table

1141 (list href)

1142 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1143

1144 (defvar yahtml-parameters-completion-alist

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

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

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

1148 ("src" . file) ("file" . file)

1149 ("background" . file)

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

1151 ("method" ("POST") ("GET"))

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

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

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

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

1156 ("http-equiv" ("Refresh"))))

1157

1158 (defvar yahtml-link-types-alist

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

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

1161 ("subsection") ("appendix") ("help") ("bookmark")))

1162

1163 (defvar yahtml-content-types-alist

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

1165 ("text/sgml") ("text/xml")

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

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

1168 ("application/java")

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

1170 "Alist of content-types")

1171

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

1173 (let* ((alist

1174 (cdr-safe (assoc (downcase par)

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

1176 (prompt (concat par ": "))

1177 v)

1178 (cond

1179 ((eq alist 'file)

1180 (let ((insert-default-directory))

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

1182 ((eq alist 'command)

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

1184 (read-shell-command prompt)

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

1186 ((and alist (symbolp alist))

1187 (completing-read-with-history

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

1189 (alist

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

1191 (t

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

1193

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

1195 "Make optional argument string."

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

1197 ""

1198 (concat " "

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

1200 "=\"" arg "\"")))

1201

1202 (defun yahtml:html ()

1203 "Add-in for <html>"

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

1205 (yahtml-make-optional-argument

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

1207

1208 (defun yahtml:head ()

1209 "Add-in for <head>"

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

1211 "")

1212

1213 (defun yahtml:body ()

1214 "Add-in function for <body>"

1215 (cond

1216 (yahtml-html4-strict nil)

1217 (t

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

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

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

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

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

1223 (concat

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

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

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

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

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

1229

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

1231 "Make CSS property definitions in style attribute."

1232 (mapconcat

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

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

1235 (delq nil proplist)

1236 " "))

1237

1238 (defun yahtml:img ()

1239 "Add-in function for <img>"

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

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

1242 alt

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

1244 (l yahtml-prefer-upcase-attributes)

1245 info width height bytes comments)

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

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

1248 (car info)

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

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

1251 bytes (car (cdr (cdr info)))

1252 comments (nth 4 info)))

1253 (if info

1254 (setq alt

1255 (YaTeX-replace-formats

1256 yahtml:img-default-alt-format

1257 (list (cons "x" width)

1258 (cons "y" height)

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

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

1261 (cons "c" (car comments))))))

1262

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

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

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

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

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

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

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

1270 (if yahtml-html4-strict

1271 (yahtml-make-optional-argument

1272 "style"

1273 (if (or brd alg)

1274 (yahtml-make-style-parameter

1275 (list

1276 (if (string< "" alg)

1277 (cons "align" alg))

1278 (if (string< "" brd)

1279 (cons "border"

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

1281 (concat

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

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

1284

1285 (defun yahtml-file-truename (file)

1286 (cond

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

1288 (t (let ((new file))

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

1290 (not (equal new file)))

1291 (setq file new))

1292 file))))

1293

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

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

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

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

1298 (let ((mlt 1)

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

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

1301 (value 0))

1302 (while (> length 0)

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

1304 pos (+ pos direc)

1305 mlt (* mlt 256)

1306 length (1- length)))

1307 value))

1308

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

1310 "Return the information on the image file FILE.

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

1312 (save-excursion

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

1314 width height bytes depth comment

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

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

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

1318 (seekpoint 1)

1319 c1 c2 c3 c4 beg end

1320 (case-fold-search nil))

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

1322 (set-buffer tmpbuf)

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

1324 (erase-buffer)

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

1326 (unwind-protect

1327 (progn

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

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

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

1331 (YaTeX-insert-file-contents

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

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

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

1335 c2 (char-after 2)

1336 c3 (char-after 3)

1337 c4 (char-after 4))

1338 (cond

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

1340 ;;JPEG images need JPEG markers inspection

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

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

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

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

1345 (catch 'exit

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

1347 (cond

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

1349 ;maybe corrupted, exit from loop

1350 (throw 'exit t))

1351 ((memq

1352 (char-after (1+ seekpoint))

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

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

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

1356 ;;found!

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

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

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

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

1361 ;; JPEG comment area

1362 (setq beg (+ seekpoint 2 2)

1363 end (+ seekpoint

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

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

1366 (t ;other markers

1367 nil)) ;just skip it

1368 (setq seekpoint (+ seekpoint 2)

1369 seekpoint (+ seekpoint

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

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

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

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

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

1375 height (yahtml-hex-value 20 4)

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

1377 ((looking-at "GIF8")

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

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

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

1381 ((looking-at "BM")

1382 ;;# OS/2, Windoze BMP files

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

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

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

1386 (cond

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

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

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

1390 (t

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

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

1393 (message "")

1394 (kill-buffer tmpbuf))

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

1396

1397 (defun yahtml:form ()

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

1399 (concat

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

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

1402 "\""

1403 (yahtml-make-optional-argument

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

1405 (completing-read-with-history

1406 "Enctype: "

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

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

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

1410

1411 (defun yahtml:select ()

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

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

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

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

1416

1417 (defun yahtml:ol ()

1418 "Add-in function for <ol>"

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

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

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

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

1423 (concat

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

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

1426 (defun yahtml:ul ()

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

1428 (defun yahtml:dl ()

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

1430 (defun yahtml:dt ()

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

1432

1433 (defun yahtml:p ()

1434 (if yahtml-html4-strict nil

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

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

1437

1438 (defvar yahtml-input-types

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

1440 ("reset") ("image") ("hidden") ("file")))

1441

1442 (defun yahtml:input ()

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

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

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

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

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

1448 yahtml-input-types nil t)

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

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

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

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

1453 (concat

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

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

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

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

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

1459

1460 (defun yahtml:textarea ()

1461 "Add-in function for `textarea'"

1462 (interactive)

1463 (let (name rows cols)

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

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

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

1467 (concat

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

1469 "\"" name "\"")

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

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

1472

1473 (defun yahtml:table ()

1474 "Add-in function for `table'"

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

1476 (a (yahtml-read-parameter

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

1478 (if yahtml-html4-strict

1479 (yahtml-make-optional-argument

1480 "style"

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

1482 (yahtml-make-style-parameter

1483 (append

1484 (if (string< "" b)

1485 (list

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

1487 (cons "border-collapse" "collapse")))

1488 (if (string< "" a)

1489 (cond

1490 ((string-match "right" a)

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

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

1493 ((string-match "center" a)

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

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

1496 (concat

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

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

1499

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

1501 (defun yahtml:caption ()

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

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

1504 (if yahtml-html4-strict

1505 (yahtml-make-optional-argument

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

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

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

1509

1510 (defun yahtml:font ()

1511 "Add-in function for `font'"

1512 (concat

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

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

1515

1516 (defun yahtml:style ()

1517 "Add-in function for `style'"

1518 (yahtml-make-optional-argument

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

1520

1521 (defun yahtml:script ()

1522 "Add-in function for `script'"

1523 (concat

1524 (yahtml-make-optional-argument

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

1526 (yahtml-make-optional-argument

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

1528

1529 (defun yahtml:tr ()

1530 "Add-in function for `tr'"

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

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

1533 "")

1534

1535 (defun yahtml:link ()

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

1537 (let (rel rev type href)

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

1539 (cond

1540 ((equal rel "")

1541 (concat (yahtml-make-optional-argument

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

1543 (yahtml-make-optional-argument

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

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

1546 )))

1547 ((string-match "stylesheet" rel)

1548 (concat

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

1550 (yahtml-make-optional-argument

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

1552 (progn

1553 (setq href

1554 (read-from-minibuffer-with-history

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

1556 (if (string< "" href)

1557 (progn

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

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

1560 (setq yahtml-css-class-alist

1561 (yahtml-css-collect-classes-file

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

1563 (message "")

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

1565 (t

1566 (concat

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

1568 (yahtml-make-optional-argument

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

1570 (yahtml-make-optional-argument

1571 "href"

1572 (read-from-minibuffer-with-history

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

1574

1575 (defvar yahtml:meta-names

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

1577

1578 (defun yahtml:meta ()

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

1580 "name"

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

1582 http-equiv content)

1583 (if (string= "" name)

1584 (if (string-match

1585 "Content-type"

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

1587 "http-equiv"

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

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

1590 "See docs/qanda")

1591 (concat http-equiv

1592 (yahtml-make-optional-argument

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

1594 (concat

1595 name

1596 (yahtml-make-optional-argument

1597 "content"

1598 (cond

1599 ((string-match "date" name)

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

1601 ((string-match "author" name)

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

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

1604 (user-full-name)

1605 (user-login-name))))

1606 ((string-match "GENERATOR" name)

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

1608 "Generator: " "User-agent: "))

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

1610 (message "Thank you!"))

1611 content)

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

1613

1614 (defun yahtml:br ()

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

1616

1617 (defun yahtml:object ()

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

1619 data classid)

1620 (cond

1621 ((string-match "java" codetype)

1622 (let ((completion-ignored-extensions

1623 ;;any extensions except ".class"

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

1625 (setq classid (concat "java:"

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

1627 (concat

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

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

1630 (yahtml-make-optional-argument

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

1632 (yahtml-make-optional-argument

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

1634 (yahtml-make-optional-argument

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

1636 (t

1637 ""))))

1638

1639 (defun yahtml:abbr ()

1640 "Add-in function for abbr."

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

1642

1643 (defun yahtml:button ()

1644 (concat

1645 (yahtml-make-optional-argument

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

1647 (yahtml-make-optional-argument

1648 "type" (yahtml-read-parameter

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

1650 (yahtml-make-optional-argument

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

1652

1653 ;;; ---------- Simple tag ----------

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

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

1656 (interactive "P")

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

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

1659 (or tag

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

1661 (setq tag

1662 (YaTeX-cplread-with-learning

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

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

1665 'yahtml-typeface-table 'yahtml-user-typeface-table

1666 'yahtml-tmp-typeface-table))))

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

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

1669 (setq yahtml-last-typeface-cmd tag

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

1671 (if region-mode

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

1673 (save-excursion

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

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

1676 (exchange-point-and-mark)

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

1678 (message "No mark set now"))

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

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

1681

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

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

1684 (interactive)

1685 (yahtml-insert-tag t tag))

1686

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

1688 (defun yahtml-insert-single (cmd)

1689 "Insert <CMD>."

1690 (interactive

1691 (list

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

1693 (YaTeX-cplread-with-learning

1694 (format "Command%s: "

1695 (if yahtml-last-single-cmd

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

1697 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1700 (setq yahtml-last-single-cmd

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

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

1703 yahtml-last-single-cmd))

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

1705 cmd

1706 (yahtml-addin cmd)

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

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

1709 " /" "")))

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

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

1712

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

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

1715 (interactive "P")

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

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

1718

1719 (defun yahtml-insert-amps (arg)

1720 "Insert char-entity references via ampersand"

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

1722 (interactive "P")

1723 (let*((mess "") c

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

1725 yahtml-entity-reference-chars-alist))

1726 (l list))

1727 (while l

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

1729 l (cdr l)))

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

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

1732 (setq c (read-char))

1733 (cond

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

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

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

1737 (insert "&;")

1738 (forward-char -1))

1739 ((equal c ? )

1740 (insert ?&))

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

1742 (setq c (preceding-char))

1743 (delete-backward-char 1)

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

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

1746

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

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

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

1750

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

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

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

1754

1755 ;;; ---------- Jump ----------

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

1757 "Check if point is on href clause."

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

1759 (save-excursion

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

1761 (save-excursion

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

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

1764 (setq e (point)))

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

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

1767 (search-forward "href" e t)

1768 (search-forward "=" e t)

1769 (progn

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

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

1772 (< p (match-end 0))

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

1774

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

1776 (cond

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

1778 (set-process-buffer proc nil))

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

1780 (let ((cb (current-buffer)))

1781 (set-buffer (process-buffer proc))

1782 (goto-char (point-min))

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

1784 (progn

1785 (message "Starting netscape...")

1786 (start-process

1787 "browser" (process-buffer proc)

1788 shell-file-name yahtml-shell-command-option

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

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

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

1792 (set-buffer cb)))))

1793

1794 (defvar yahtml-browser-process nil)

1795

1796 (defun yahtml-browse-html (href)

1797 "Call WWW Browser to see HREF."

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

1799 (cond

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

1801 (if (get-buffer pb)

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

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

1804 (set-process-sentinel

1805 (setq yahtml-browser-process

1806 (start-process

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

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

1809 'yahtml-netscape-sentinel))

1810 ((and (string-match

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

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

1813 (if (get-buffer pb)

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

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

1816 (set-process-sentinel

1817 (setq yahtml-browser-process

1818 (start-process

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

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

1821 'yahtml-netscape-sentinel))

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

1823 (w3-fetch href))

1824 ((stringp yahtml-www-browser)

1825 (if (and yahtml-browser-process

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

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

1828 (setq yahtml-browser-process

1829 (start-process

1830 "browser" "* WWW Browser *"

1831 shell-file-name yahtml-shell-command-option

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

1833 (t

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

1835

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

1837 "Go to corresponding name."

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

1839 (if href

1840 (cond

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

1842 (yahtml-browse-html href))

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

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

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

1846 (if (string< "" file)

1847 (progn

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

1849 (or (catch 'dirindex

1850 (mapcar

1851 (function

1852 (lambda (f)

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

1854 (throw 'dirindex

1855 (setq file (concat file f))))))

1856 (yahtml-get-directory-index))

1857 nil)

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

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

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

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

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

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

1864 (if name

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

1866 t)))))

1867

1868 (defun yahtml-jump-to-name (name)

1869 "Jump to html's named tag."

1870 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1871 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1872 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1873 (message "Named tag `%s' not found" (substring href 1))))

1874

1875 (defun yahtml-on-begend-p (&optional p)

1876 "Check if point is on begend clause."

1877 (let ((p (or p (point))) cmd (case-fold-search t))

1878 (save-excursion

1879 (goto-char p)

1880 (if (equal (char-after (point)) ?<) (forward-char 1))

1881 (if (and (re-search-backward "<" nil t)

1882 (looking-at

1883 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1884 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1885 (condition-case nil

1886 (forward-list 1)

1887 (error nil))

1888 (< p (point)))

1889 (YaTeX-match-string 1)))))

1890

1891 (defun yahtml-goto-corresponding-begend (&optional noerr)

1892 "Go to corresponding opening/closing tag.

1893 Optional argument NOERR causes no error for unballanced tag."

1894 (let ((cmd (yahtml-on-begend-p)) m0

1895 (p (point)) (case-fold-search t) func str (nest 0))

1896 (cond

1897 (cmd

1898 (setq m0 (match-beginning 0))

1899 (if (= (aref cmd 0) ?/) ;on </cmd> line

1900 (setq cmd (substring cmd 1)

1901 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1902 func 're-search-backward)

1903 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1904 func 're-search-forward))

1905 (while (and (>= nest 0) (funcall func str nil t))

1906 (if (equal m0 (match-beginning 0))

1907 nil

1908 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1909 (if (< nest 0)

1910 (goto-char (match-beginning 0))

1911 (funcall

1912 (if noerr 'message 'error)

1913 "Corresponding tag of `%s' not found." cmd)

1914 (goto-char p)

1915 nil))

1916 (t nil))))

1917

1918 (defun yahtml-current-tag ()

1919 "Return the current tag name including #exec and #include."

1920 (save-excursion

1921 (let ((p (point)) b tag)

1922 (or (bobp)

1923 (looking-at "<")

1924 (progn (skip-chars-backward "^<") (forward-char -1)))

1925 (setq b (point))

1926 (skip-chars-forward "<")

1927 (setq tag (YaTeX-buffer-substring

1928 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1929 (goto-char b)

1930 (forward-list 1)

1931 (and (< p (point)) tag))))

1932

1933 (defun yahtml-get-attrvalue (attr)

1934 "Extract current tag's attribute value from buffer."

1935 (let (e (case-fold-search t))

1936 (save-excursion

1937 (or (looking-at "<")

1938 (progn (skip-chars-backward "^<") (backward-char 1)))

1939 (setq e (save-excursion (forward-list 1) (point)))

1940 (if (and

1941 (re-search-forward (concat "\\b" attr "\\b") e t)

1942 (progn (skip-chars-forward " \t\n=")

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

1944 (YaTeX-match-string 1)))))

1945

1946 (defun yahtml-goto-corresponding-img ()

1947 "View image on point"

1948 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1949 (if (and tag

1950 (string-match "img" tag)

1951 (setq image

1952 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1953 (progn

1954 (message "Invoking %s %s..." yahtml-image-viewer image)

1955 (start-process

1956 "Viewer" " * Image Viewer *"

1957 shell-file-name yahtml-shell-command-option ;"-c"

1958 (concat yahtml-image-viewer " " image))

1959 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1960

1961 (defun yahtml-goto-corresponding-source (&optional other)

1962 "Goto applet's or script's source."

1963 (let ((env (yahtml-current-tag)) s (p (point)))

1964 (cond

1965 ((string-match "applet" env)

1966 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1967 (progn

1968 (setq s (YaTeX-match-string 1)

1969 s (concat

1970 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1971 ".java"))

1972 (if other (YaTeX-switch-to-buffer-other-window s)

1973 (YaTeX-switch-to-buffer s))

1974 s) ;return source file name

1975 (message "No applet source specified")

1976 (sit-for 1)

1977 nil))

1978 ((string-match "script" env)

1979 (if (setq s (yahtml-get-attrvalue "src"))

1980 (progn

1981 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1982 'YaTeX-switch-to-buffer)

1983 (yahtml-url-to-path s))

1984 s)))

1985 ((string-match "!--#include" env)

1986 (cond

1987 ((setq s (yahtml-get-attrvalue "file")) ;

1988 (if other (YaTeX-switch-to-buffer-other-window s)

1989 (YaTeX-switch-to-buffer s))

1990 s)

1991 ((setq s (yahtml-get-attrvalue "virtual"));

1992 (setq s (yahtml-url-to-path s))

1993 (if other (YaTeX-switch-to-buffer-other-window s)

1994 (YaTeX-switch-to-buffer s))

1995 s)))

1996 ((and (string-match "!--#exec" env)

1997 (setq s (yahtml-get-attrvalue "cmd")))

1998 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1999 (let ((b " *yahtmltmp*")) ;peek a little

2000 (unwind-protect

2001 (progn

2002 (set-buffer (get-buffer-create b))

2003 (YaTeX-insert-file-contents s nil 0 100)

2004 (if (looking-at "#!")

2005 (if other (YaTeX-switch-to-buffer-other-window s)

2006 (YaTeX-switch-to-buffer s))))

2007 (kill-buffer (get-buffer b)))

2008 (get-file-buffer s))))))

2009

2010 (defun yahtml-goto-corresponding-* (&optional other)

2011 "Go to corresponding object."

2012 (interactive "P")

2013 (cond

2014 ((yahtml-goto-corresponding-href other))

2015 ((yahtml-goto-corresponding-img))

2016 ((yahtml-goto-corresponding-source other))

2017 ((yahtml-goto-corresponding-begend))

2018 (t (message "I don't know where to go."))))

2019

2020 (defun yahtml-goto-corresponding-*-other-window ()

2021 "Go to corresponding object."

2022 (interactive)

2023 (yahtml-goto-corresponding-* t))

2024

2025 (defun yahtml-visit-main ()

2026 "Go to parent file from where you visit current file."

2027 (interactive)

2028 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2029

2030 ;;; ---------- killing ----------

2031 (defun yahtml-kill-begend (&optional whole)

2032 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2033 (if tag

2034 (save-excursion

2035 (or (looking-at "<")

2036 (progn (skip-chars-backward "^<") (forward-char -1)))

2037 (setq p (point))

2038 (yahtml-goto-corresponding-begend)

2039 (or (looking-at "<")

2040 (progn (skip-chars-backward "^<") (forward-char -1)))

2041 (if (< (point) p) ;if on the opening tag

2042 (progn (setq q p p (point))

2043 (goto-char q))

2044 (setq q (point))) ;now q has end-line's (point)

2045 (if (not whole)

2046 (kill-region

2047 (progn (skip-chars-backward " \t")

2048 (if (setq bbolp (bolp)) (point) q))

2049 (progn (forward-list 1)

2050 (setq r (point))

2051 (skip-chars-forward " \t")

2052 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2053 (goto-char p)

2054 (skip-chars-backward " \t")

2055 (if (not whole)

2056 (progn

2057 (kill-append

2058 (buffer-substring

2059 (setq p (if (setq bbolp (bolp)) (point) p))

2060 (setq q (progn

2061 (forward-list 1)

2062 (setq r (point))

2063 (skip-chars-forward " \t")

2064 (if (and bbolp (eolp) (not (eobp)))

2065 (1+ (point))

2066 r))))

2067 t)

2068 (delete-region p q))

2069 (kill-region

2070 (if (bolp) (point) p)

2071 (progn (goto-char q)

2072 (forward-list 1)

2073 (setq r (point))

2074 (skip-chars-forward " \t")

2075 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2076 tag))))

2077

2078 (defun yahtml-kill-* (whole)

2079 "Kill current position's HTML tag (set)."

2080 (interactive "P")

2081 (cond

2082 ((yahtml-kill-begend whole))))

2083

2084

2085 ;;; ---------- changing ----------

2086 (defun yahtml-on-assignment-p ()

2087 "Return if current point is on parameter assignment.

2088 If so, return parameter name, otherwise nil.

2089 This function should be able to treat white spaces in value, but not yet."

2090 (let ((p (point)))

2091 (save-excursion

2092 (put 'yahtml-on-assignment-p 'region nil)

2093 (skip-chars-backward "^ \t\n")

2094 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2095 (< p (match-end 0))

2096 (>= p (1- (match-beginning 2)))

2097 (put 'yahtml-on-assignment-p 'region

2098 (cons (match-beginning 2) (match-end 2)))

2099 (YaTeX-match-string 1)))))

2100

2101 (defun yahtml-change-begend ()

2102 (let ((tag (yahtml-on-begend-p))

2103 (completion-ignore-case t)

2104 (case-fold-search t)

2105 (p (point)) (q (make-marker))

2106 (default (append yahtml-env-table yahtml-typeface-table))

2107 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2108 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2109 href b1 e1 attr new css)

2110 (cond

2111 (tag

2112 (cond

2113 ((and (string-match "^a$" tag)

2114 (save-excursion

2115 (and

2116 (re-search-backward "<a\\b" nil t)

2117 (progn

2118 (goto-char (match-end 0))

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

2120 (setq b1 (point))

2121 (search-forward ">" nil t))

2122 (setq e1 (match-beginning 0))

2123 (goto-char b1)

2124 (re-search-forward "href\\s *=" e1 t)

2125 (>= p (point))

2126 (progn

2127 (goto-char (match-end 0))

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

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

2130 (< p (match-end 0)))))

2131 (setq b1 (match-beginning 1) e1 (match-end 1)

2132 yahtml-completing-buffer (current-buffer)

2133 ;; yahtml-urls-local is buffer-local, so we must put

2134 ;; that into yahtml-urls here

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

2136 href (read-from-minibuffer

2137 "Change href to: " "" yahtml-url-completion-map))

2138 (if (string< "" href)

2139 (progn

2140 ;;(setq href ;??

2141 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2142 (delete-region b1 e1)

2143 (goto-char b1)

2144 (insert href))))

2145 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2146 (if (and (equal attr "class") ;treat "class" attribute specially

2147 (setq css (yahtml-css-get-element-completion-alist tag)))

2148

2149 (setq new (yahtml-read-css css tag))

2150 ;;other than "class", read parameter normally

2151 (setq new (yahtml-read-parameter attr)))

2152 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2153 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2154 (insert new))

2155 (t

2156 (save-excursion

2157 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2158 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2159 (skip-chars-forward "^A-Za-z")

2160 (set-marker q (point))

2161 (setq p (point))

2162 (yahtml-goto-corresponding-begend)

2163 (or (= (char-after (point)) ?<)

2164 (skip-chars-backward "^<"))

2165 (skip-chars-forward "^A-Za-z")

2166 (if (= (char-after (1- (point))) ?/)

2167 (progn

2168 (set-marker q (point))

2169 (goto-char p)))

2170 (setq tag (let ((completion-ignore-case t))

2171 (YaTeX-cplread-with-learning

2172 (format "Change `%s' to(default %s): "

2173 tag yahtml-last-begend)

2174 'default 'user 'tmp)))

2175 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2176 (if (string= "" tag) (setq tag yahtml-last-begend))

2177 (setq yahtml-last-begend

2178 (or (cdr (assoc tag yahtml-env-table)) tag)

2179 tag yahtml-last-begend)

2180 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2181 (insert (format "%s%s" tag (yahtml-addin tag)))

2182 (goto-char q)

2183 (set-marker q nil)

2184 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2185 (insert tag))))

2186 t))))

2187

2188 (defun yahtml-change-command ()

2189 (let ((p (point)) (case-fold-search t) cmd par new

2190 (beg (make-marker)) (end (make-marker)))

2191 (skip-chars-backward "^<")

2192 (if (and

2193 (looking-at yahtml-command-regexp)

2194 (progn

2195 (set-marker beg (match-beginning 0))

2196 (set-marker end (match-end 0))

2197 t) ;for further work

2198 (progn

2199 (forward-char -1)

2200 (condition-case nil

2201 (forward-list 1)

2202 (error nil))

2203 (< p (point))))

2204 (progn

2205 (goto-char p)

2206 (if (setq par (yahtml-on-assignment-p))

2207 (progn

2208 (setq new (yahtml-read-parameter par))

2209 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2210 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2211 (setq new

2212 (YaTeX-cplread-with-learning

2213 "Change form to: "

2214 'yahtml-form-table 'yahtml-user-form-table

2215 'yahtml-tmp-form-table)))

2216 (delete-region beg end)

2217 (goto-char beg)

2218 (set-marker beg nil)

2219 (set-marker end nil)

2220 (insert new)

2221 t)

2222 (goto-char p)

2223 nil)))

2224

2225 (defun yahtml-change-* ()

2226 "Change current position's HTML tag (set)."

2227 (interactive)

2228 (cond

2229 ((yahtml-change-begend))

2230 ((yahtml-change-command))))

2231

2232 ;;; ---------- commenting ----------

2233

2234 (defun yahtml-comment-region (&optional uncom)

2235 "Comment out region or environment."

2236 (interactive)

2237 (let ((e (make-marker)) be beg p)

2238 (cond

2239 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2240 (setq be (yahtml-on-begend-p))

2241 (save-excursion

2242 (setq p (point))

2243 (if (string-match "^/" be)

2244 (setq beg (progn (forward-line 1) (point)))

2245 (setq beg (progn (beginning-of-line) (point))))

2246 (goto-char p)

2247 (yahtml-goto-corresponding-begend)

2248 (if (string-match "^/" be)

2249 (beginning-of-line)

2250 (forward-line 1))

2251 (set-marker e (point))

2252 ;(comment-region beg (point) (if uncom (list 4)))))

2253 ))

2254 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2255 (setq beg (region-beginning))

2256 (set-marker e (region-end))))

2257 (if yahtml-translate-hyphens-when-comment-region

2258 (let ((yahtml-entity-reference-chars-alist-default nil)

2259 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2260 yahtml-entity-reference-chars-regexp

2261 yahtml-entity-reference-chars-reverse-regexp)

2262 (yahtml-entity-reference-chars-setup)

2263 (funcall

2264 (if uncom 'yahtml-translate-reverse-region

2265 'yahtml-translate-region)

2266 beg e)))

2267 (comment-region beg e (if uncom (list 4)))

2268 (set-marker e nil)))

2269

2270 (defun yahtml-uncomment-region ()

2271 (interactive)

2272 (yahtml-comment-region t))

2273

2274 ;;; ---------- translate to entity references ----------

2275 (defvar yahtml-entity-reference-chars-alist-default

2276 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2277 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2278 "Default translation table from character to entity reference")

2279 (defvar yahtml-entity-reference-chars-alist nil

2280 "*Translation table from character to entity reference")

2281 (defvar yahtml-entity-reference-chars-regexp nil)

2282 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2283

2284 (defun yahtml-entity-reference-chars-setup ()

2285 (let ((list (append yahtml-entity-reference-chars-alist-default

2286 yahtml-entity-reference-chars-alist)))

2287 (setq yahtml-entity-reference-chars-regexp "["

2288 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2289 (while list

2290 (setq yahtml-entity-reference-chars-regexp

2291 (concat yahtml-entity-reference-chars-regexp

2292 (char-to-string (car (car list))))

2293 yahtml-entity-reference-chars-reverse-regexp

2294 (concat yahtml-entity-reference-chars-reverse-regexp

2295 (cdr (car list))

2296 (if (cdr list) "\\|")))

2297 (setq list (cdr list)))

2298 (setq yahtml-entity-reference-chars-regexp

2299 (concat yahtml-entity-reference-chars-regexp "]")

2300 yahtml-entity-reference-chars-reverse-regexp

2301 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2302

2303 (yahtml-entity-reference-chars-setup)

2304

2305 (defun yahtml-translate-region (beg end)

2306 "Translate inhibited literals."

2307 (interactive "r")

2308 (save-excursion

2309 (save-restriction

2310 (narrow-to-region beg end)

2311 (let ((ct (append yahtml-entity-reference-chars-alist

2312 yahtml-entity-reference-chars-alist-default)))

2313 (goto-char beg)

2314 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2315 ;(setq c (preceding-char))

2316 (replace-match

2317 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2318

2319 (defun yahtml-translate-reverse-region (beg end)

2320 "Translate entity references to literals."

2321 (interactive "r")

2322 (save-excursion

2323 (save-restriction

2324 (narrow-to-region beg end)

2325 (let ((ct (append yahtml-entity-reference-chars-alist

2326 yahtml-entity-reference-chars-alist-default))

2327 ec)

2328 (goto-char beg)

2329 (while (re-search-forward

2330 yahtml-entity-reference-chars-reverse-regexp nil t)

2331 ;(setq c (preceding-char))

2332 (setq ec (YaTeX-match-string 1))

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

2334 (insert (car (YaTeX-rassoc ec ct))))))))

2335

2336 (defun yahtml-inner-environment-but (exclude &optional quick)

2337 "Return the inner environment but matches with EXCLUDE tag."

2338 (let (e (case-fold-search t))

2339 (save-excursion

2340 (while (and (setq e (YaTeX-inner-environment quick))

2341 (string-match exclude e))

2342 (goto-char (get 'YaTeX-inner-environment 'point))))

2343 e))

2344

2345 (defun yahtml-untranslate-string (str)

2346 "Untranslate entity reference."

2347 (let ((md (match-data)) (left "") (right str) b0 ch

2348 (ct (append yahtml-entity-reference-chars-alist

2349 yahtml-entity-reference-chars-alist-default))

2350 (revrex yahtml-entity-reference-chars-reverse-regexp))

2351 (unwind-protect

2352 (progn

2353 (while (string< "" right)

2354 (cond

2355 ((string-match revrex right)

2356 (setq ch (YaTeX-rassoc

2357 (substring right (match-beginning 1) (match-end 1)))

2358 b0 (substring right 0 (match-beginning 0))

2359 right (substring right (match-end 0))

2360 left (concat left

2361 (substring right 0 (match-beginning 0))

2362 (char-to-string ch))))

2363 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2364 (setq ch (substring right (match-beginning 2) (match-end 2))

2365 b0 (substring right 0 (match-beginning 0))

2366 right (substring right (match-end 0))

2367 left (concat left

2368 b0

2369 (char-to-string

2370 (if (match-beginning 1)

2371 (YaTeX-hex ch)

2372 (string-to-number ch))))))

2373 (t (setq left (concat left right)

2374 right ""))))

2375 left)

2376 (store-match-data md))))

2377

2378 ;;; ---------- table-ize region ----------

2379 (defun yahtml-td-region (e delim beg end)

2380 "Enclose each item in a region with <td>..</td>.

2381 Interactive prefix argument consults enclosing element other than td."

2382 (interactive "P\nsDelimiter(s): \nr")

2383 (let ((e (cond

2384 ((null e) "td")

2385 ((stringp e) e)

2386 (t (read-string-with-history

2387 "Enclose with(`thd' means th td td..): " "th"))))

2388 (ws "[ \t]")

2389 elm p i)

2390 (if (string= delim "") (setq delim " \t\n"))

2391 (setq delim (concat "[" delim "]+")

2392 elm (if (string= "thd" e)

2393 (cons "th" "td")

2394 (cons e e)))

2395 (save-excursion

2396 (save-restriction

2397 (narrow-to-region beg end)

2398 (goto-char (setq p (point-min)))

2399 (setq i 0 e (car elm))

2400 (while (re-search-forward delim nil t)

2401 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2402 (goto-char (match-beginning 0))

2403 (insert "</" e ">")

2404 (save-excursion

2405 (goto-char p)

2406 (insert "<" e ">"))

2407 (setq p (point))

2408 (while (and (not (eobp)) (looking-at ws))

2409 (delete-char 1))

2410 (if (looking-at delim) (delete-char 1)))

2411 (insert "<" e ">")

2412 (goto-char (point-max))

2413 (insert "</" e ">")))))

2414

2415 (defun yahtml-tr-region (e delim beg end)

2416 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2417 (interactive "P\nsDelimiter(s): \nr")

2418 (setq e (if (and e (listp e))

2419 (read-string-with-history

2420 "Enclose with(td or th, `thd' -> th td td td...: " "th")))

2421 (save-excursion

2422 (save-restriction

2423 (narrow-to-region (point) (mark))

2424 (goto-char (point-min))

2425 (while (not (eobp))

2426 (insert "<tr>")

2427 (yahtml-td-region e delim (point) (point-end-of-line))

2428 (end-of-line)

2429 (insert "</tr>")

2430 (forward-line 1)))))

2431

2432 ;;; ---------- filling ----------

2433 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2434 (defun yahtml-move-to-column (col &optional force)

2435 (beginning-of-line)

2436 (let ((ccol 0))

2437 (while (and (> col ccol) (not (eolp)))

2438 (if (eq (following-char) ?\<)

2439 (progn

2440 (while (and (not (eq (following-char) ?\>))

2441 (not (eolp)))

2442 (forward-char))

2443 (or (eolp) (forward-char)))

2444 (or (eolp) (forward-char))

2445 (if (eq (preceding-char) ?\t)

2446 (let ((wd (- 8 (% (+ ccol 8) 8))))

2447 (if (and force (< col (+ ccol wd)))

2448 (progn

2449 (backward-char 1)

2450 (insert-char ?\ (- col ccol))

2451 (setq ccol col))

2452 (setq ccol (+ ccol wd))))

2453 (setq ccol (1+ ccol)))

2454 (if (and YaTeX-japan

2455 (or

2456 (and (fboundp 'char-category)

2457 (string-match "[chj]" (char-category (preceding-char))))

2458 (and (fboundp 'char-charset)

2459 (not (eq (char-charset (preceding-char)) 'ascii)))))

2460 (setq ccol (1+ ccol)))))

2461 (if (and force (> col ccol))

2462 (progn

2463 (insert-char ?\ (- col ccol))

2464 col)

2465 ccol)))

2466

2467 (defun yahtml-fill-paragraph (arg)

2468 (interactive "P")

2469 (let*((case-fold-search t) (p (point)) fill-prefix

2470 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2471 indent

2472 (startp (get 'YaTeX-inner-environment 'point))

2473 (prep (string-match "^pre$" e))

2474 (ps1 (if prep (default-value 'paragraph-start)

2475 paragraph-start))

2476 (ps2 (if prep (concat (default-value 'paragraph-start)

2477 "$\\|^\\s *</?pre>")

2478 paragraph-start)))

2479 (save-excursion

2480 (unwind-protect

2481 (progn

2482 (if prep

2483 (fset 'move-to-column 'yahtml-move-to-column))

2484 (save-excursion

2485 (beginning-of-line)

2486 (indent-to-column (yahtml-this-indent))

2487 (setq fill-prefix

2488 (buffer-substring (point) (point-beginning-of-line)))

2489 (delete-region (point) (point-beginning-of-line)))

2490 (fill-region-as-paragraph

2491 (progn (re-search-backward paragraph-start nil t)

2492 (or (save-excursion

2493 (goto-char (match-beginning 0))

2494 (if (looking-at "<")

2495 (forward-list)

2496 (goto-char (match-end 0))

2497 (skip-chars-forward " \t>"))

2498 (if (looking-at "[ \t]*$")

2499 (progn (forward-line 1) (point))))

2500 (point)))

2501 (progn (goto-char p)

2502 (re-search-forward ps2 nil t)

2503 (match-beginning 0))))

2504 (fset 'move-to-column yahtml-saved-move-to-column)))))

2505

2506 ;;;

2507 ;;; ---------- move forward/backward field ----------

2508 ;;;

2509 (defun yahtml-element-path ()

2510 "Return the element path from <body> at point as a list"

2511 (let (path elm)

2512 (save-excursion

2513 (while (and (YaTeX-beginning-of-environment)

2514 (looking-at (concat "<\$" yahtml-command-regexp "\$\\>"))

2515 (not (string= (setq elm (downcase (YaTeX-match-string 1)))

2516 "body")))

2517 (setq path (cons elm path)

2518 elm nil))

2519 (and elm (setq path (cons elm path))))))

2520

2521 (defun yahtml-forward-field (arg)

2522 "Move ARGth forward cell to table element.

2523 ENVINFO is a cons of target element name and its beginning point."

2524 (interactive "p")

2525 (let (inenv elm path sibs)

2526 (cond

2527 ((< arg 0) (yahtml-backward-field (- arg)))

2528 ((= arg 0) nil)

2529 ((and (setq path (nreverse (yahtml-element-path)))

2530 (catch 'sibling

2531 (while path

2532 (if (setq elm (car-safe

2533 (member (car path) '("td" "th" "li" "dt" "dd"))))

2534 (throw 'sibling elm))

2535 (setq path (cdr path)))))

2536 (setq inenv (YaTeX-in-environment-p elm)

2537 sibs (cdr (assoc elm '(("td" . "td\\|th")

2538 ("th" . "td\\|th")

2539 ("li" . "li")

2540 ("dt" . "dt\\|dd")

2541 ("dd" . "dt\\|dd")))))

2542 (goto-char (cdr inenv))

2543 (while (>= (setq arg (1- arg)) 0)

2544 (yahtml-goto-corresponding-begend)

2545 (if (looking-at "<") (forward-list 1))

2546 (skip-chars-forward "^<"))

2547 (while (looking-at "\\s \\|\$</\$")

2548 (if (match-beginning 1) (forward-list 1)

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

2550 (forward-list 1) ;; step into environment

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

2552 (if (looking-at (concat "<\$" sibs "\$\\>"))

2553 (forward-list 1))

2554 ))))

2555

2556

2557 ;;;

2558 ;;; ---------- indentation ----------

2559 ;;;

2560 (defun yahtml-indent-line-1 ()

2561 "Indent a line (faster wrapper)"

2562 (interactive)

2563 (let (indent)

2564 (if (and (save-excursion

2565 (beginning-of-line) (skip-chars-forward "\t ")

2566 (not (looking-at "<")))

2567 (save-excursion

2568 (forward-line -1)

2569 (while (and (not (bobp)) (looking-at "^\\s *$"))

2570 (forward-line -1))

2571 (skip-chars-forward "\t ")

2572 (setq indent (current-column))

2573 (not (looking-at "<"))))

2574 (progn

2575 (save-excursion

2576 (beginning-of-line)

2577 (skip-chars-forward " \t")

2578 (or (= (current-column) indent)

2579 (YaTeX-reindent indent)))

2580 (and (bolp) (skip-chars-forward " \t")))

2581 (yahtml-indent-line-real))))

2582

2583 (defun yahtml-indent-line ()

2584 "Indent a line (Second level wrapper).

2585 See also yahtml-indent-line-1 and yahtml-indent-line-real."

2586 (interactive)

2587 (let ((cc (current-column)) (p (point)))

2588 (yahtml-indent-line-1)

2589 (and (= cc (current-column))

2590 (= p (point))

2591 (equal last-command 'yahtml-indent-line)

2592 (yahtml-forward-field 1))))

2593

2594

2595 (defun yahtml-this-indent ()

2597 (itemizing-envs "^\$[uod]l\\|menu\\|dir\\|li\\|d[td]\$$")

2598 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2599 (excludes

2600 "\\b\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2601 inenv p col peol (case-fold-search t))

2602 (save-excursion

2603 (beginning-of-line)

2604 (setq inenv (or (yahtml-inner-environment-but excludes t)

2605 "html")

2606 col (get 'YaTeX-inner-environment 'indent)

2607 p (get 'YaTeX-inner-environment 'point)

2608 op nil))

2609 (save-excursion

2610 (cond

2611 ((string-match (concat "^\$" envs "\$") inenv)

2612 (save-excursion

2613 (beginning-of-line)

2614 (skip-chars-forward " \t")

2615 (cond ;lookup current line's tag

2616 ((looking-at (concat "</\$" envs "\$>"))

2617 col)

2618 ((looking-at itms)

2619 (+ col yahtml-environment-indent))

2620 ((and yahtml-hate-too-deep-indentation

2621 (looking-at (concat "<\$" envs "\$")))

2622 (+ col (* 2 yahtml-environment-indent)))

2623 ((and (< p (point))

2624 (string-match itemizing-envs inenv)

2625 (save-excursion

2626 (and

2627 (setq op (point))

2628 (goto-char p)

2629 (re-search-forward itms op t)

2630 (progn

2631 (if yahtml-indent-listing-constant

2632 (setq col (+ (current-column)

2633 (if yahtml-faithful-to-htmllint 1 2)))

2634 (skip-chars-forward "^>")

2635 (skip-chars-forward ">")

2636 (skip-chars-forward " \t")

2637 (setq col (if (looking-at "$")

2638 (+ col yahtml-environment-indent)

2639 (current-column))))))))

2640 col)

2641 (t

2642 (+ col yahtml-environment-indent)))))

2643 (t col)))))

2644

2645 (defun yahtml-indent-line-real ()

2646 "Indent current line."

2647 (interactive)

2648 (YaTeX-reindent (yahtml-this-indent))

2649 (if (bolp) (skip-chars-forward " \t"))

2650 (let (peol col inenv)

2651 (if (and (setq inenv (yahtml-on-begend-p))

2652 (string-match

2653 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2654 (save-excursion

2655 (setq peol (point-end-of-line))

2656 (or (= (char-after (point)) ?<)

2657 (progn (skip-chars-backward "^<") (forward-char -1)))

2658 (setq col (current-column))

2659 (if (and (yahtml-goto-corresponding-begend t)

2660 (> (point) peol)) ;if on the different line

2661 (YaTeX-reindent col))))))

2662

2663 ;(defun yahtml-fill-item ()

2664 ; "Fill item HTML version"

2665 ; (interactive)

2666 ; (let (inenv p fill-prefix peol (case-fold-search t))

2667 ; (setq inenv (or (YaTeX-inner-environment) "html")

2668 ; p (get 'YaTeX-inner-environment 'point))

2669 ; (cond

2670 ; ((string-match "^[uod]l" inenv)

2671 ; (save-excursion

2672 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2673 ; (progn

2674 ; (goto-char (match-end 0))

2675 ; (setq col (current-column)))

2676 ; (error "No <li>, <dt>, <dd>")))

2677 ; (save-excursion

2678 ; (end-of-line)

2679 ; (setq peol (point))

2680 ; (newline)

2681 ; (indent-to-column col)

2682 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2683 ; (delete-region (point) peol)

2684 ; (fill-region-as-paragraph

2685 ; (progn (re-search-backward paragraph-start nil t) (point))

2686 ; (progn (re-search-forward paragraph-start nil t 2)

2687 ; (match-beginning 0)))))

2688 ; (t nil))))

2689

2690 ;;;

2691 ;;; ---------- Lint and Browsing ----------

2692 ;;;

2693 (defun yahtml-browse-menu ()

2694 "Browsing or other external process invokation menu."

2695 (interactive)

2696 (message "J)weblint p)Browse R)eload N)ewpage...")

2697 (let ((c (char-to-string (read-char))))

2698 (cond

2699 ((string-match "j" c)

2700 (yahtml-lint-buffer (current-buffer)))

2701 ((string-match "[bp]" c)

2702 (yahtml-browse-current-file))

2703 ((string-match "r" c)

2704 (yahtml-browse-reload))

2705 ((string-match "n" c)

2706 (call-interactively 'yahtml-newpage)))))

2707

2708 (if (fboundp 'wrap-function-to-control-ime)

2709 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2710

2711 (defvar yahtml-lint-buffer "*weblint*")

2712

2713 (defun yahtml-lint-buffer (buf)

2714 "Call lint on buffer BUF."

2715 (require 'yatexprc)

2716 (interactive "bCall lint on buffer: ")

2717 (setq buf (get-buffer buf))

2718 (YaTeX-save-buffers)

2719 (let ((bcmd (YaTeX-get-builtin "lint")))

2720 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2721 (YaTeX-typeset

2722 (concat (or bcmd yahtml-lint-program)

2723 " " (file-name-nondirectory (buffer-file-name buf)))

2724 yahtml-lint-buffer "lint" "lint")))

2725

2726 (defun yahtml-file-to-url (file)

2727 "Convert local unix file name to URL.

2728 If no matches found in yahtml-path-url-alist, return raw file name."

2729 (let ((list yahtml-path-url-alist) p url)

2730 (if (file-directory-p file)

2731 (setq file (expand-file-name yahtml-directory-index file))

2732 (setq file (expand-file-name file)))

2733 (if (string-match "^[A-Za-z]:/" file)

2734 (progn

2735 ;; (aset file 1 ?|) ;これは要らないらしい…

2736 (setq file (concat "///" file))))

2737 (while list

2738 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2739 (setq url (cdr (car list))

2740 file (substring file (match-end 0))

2741 url (concat url file)

2742 list nil))

2743 (setq list (cdr list)))

2744 (or url (concat "file:" file))))

2745

2746 (defun yahtml-url-to-path (file &optional basedir)

2747 "Convert local URL name to unix file name."

2748 (let ((list yahtml-path-url-alist) url realpath docroot

2749 (dirsufp (string-match "/$" file)))

2750 (setq basedir (or basedir

2751 (file-name-directory

2752 (expand-file-name default-directory))))

2753 (cond

2754 ((string-match "^/" file)

2755 (while list

2756 (if (file-directory-p (car (car list)))

2757 (progn

2758 (setq url (cdr (car list)))

2759 (if (string-match "\$http://[^/]*\$/" url)

2760 (setq docroot (substring url (match-end 1)))

2761 (setq docroot url))

2762 (cond

2763 ((string-match (concat "^" (regexp-quote docroot)) file)

2764 (setq realpath

2765 (expand-file-name

2766 (substring

2767 file

2768 (if (= (aref file (1- (match-end 0))) ?/)

2769 (match-end 0) ; "/foo"

2770 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2771 (car (car list))))))

2772 (if realpath

2773 (progn (setq list nil)

2774 (if (and dirsufp (not (string-match "/$" realpath)))

2775 (setq realpath (concat realpath "/")))))))

2776 (setq list (cdr list)))

2777 realpath)

2778 (t file))))

2779

2780 (defun yahtml-browse-current-file ()

2781 "Call WWW browser on current file."

2782 (interactive)

2783 (basic-save-buffer)

2784 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2785

2786 (defun yahtml-browse-reload ()

2787 "Send `reload' event to netscape."

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

2789 (cond

2790 ((string-match "[Nn]etscape" yahtml-www-browser)

2791 (if (get-buffer pb)

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

2793 ;;(or (get 'yahtml-netscape-sentinel 'url)

2794 ;; (error "Reload should be called after Browsing."))

2795 (put 'yahtml-netscape-sentinel 'url

2796 (yahtml-file-to-url (buffer-file-name)))

2797 (basic-save-buffer)

2798 (set-process-sentinel

2799 (setq yahtml-browser-process

2800 (start-process

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

2802 (format "%s -remote 'reload'" yahtml-www-browser)))

2803 'yahtml-netscape-sentinel))

2804 (t

2805 (message "Sorry, RELOAD is supported only for Netscape.")))))

2806

2807 ;;; ---------- Intelligent newline ----------

2808 (defun yahtml-intelligent-newline (arg)

2809 "Intelligent newline for HTML"

2810 (interactive "P")

2811 (let (env func)

2812 (end-of-line)

2813 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2814 "html")))

2815 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2816 (newline)

2817 (if (and env func (fboundp func))

2818 ;; if intelligent line function is defined, call that

2819 (funcall func)

2820 ;; else do the default action

2821 (if (string-match yahtml-p-prefered-env-regexp env)

2822 (yahtml-insert-p)))))

2823

2824 (defun yahtml-intelligent-newline-ul ()

2825 (interactive)

2826 (yahtml-insert-single "li")

2827 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2828 (yahtml-indent-line))

2829

2830 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2831

2832 (defun yahtml-intelligent-newline-dl ()

2833 (interactive)

2834 (let ((case-fold-search t))

2835 (if (save-excursion

2836 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2837 (get 'YaTeX-inner-environment 'point) t))

2838 (cond

2839 ((match-beginning 2)

2840 (yahtml-insert-single "dd")

2841 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

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

2843 ((match-beginning 3)

2844 (yahtml-insert-single "dt")

2845 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

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

2847 (yahtml-insert-single "dt")

2848 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

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

2850 (yahtml-indent-line)

2851 (and (string-match yahtml-p-prefered-env-regexp "dl")

2852 (string-equal yahtml-last-single-cmd "dt")

2853 (yahtml-insert-p nil))))

2854

2855 (defun yahtml-intelligent-newline-select ()

2856 (interactive)

2857 (yahtml-insert-single (if yahtml-prefer-upcases "OPTION" "option"))

2858 (yahtml-indent-line))

2859

2860 (defun yahtml-intelligent-newline-style ()

2861 (interactive)

2862 (if (save-excursion

2863 (and

2864 (re-search-backward "<style\\|<!-- " nil t)

2865 (looking-at "<style")))

2866 (let (c)

2867 (yahtml-indent-line)

2868 (setq c (current-column))

2869 (insert "<!--\n")

2870 (YaTeX-reindent c)

2871 (insert "-->")

2872 (beginning-of-line)

2873 (open-line 1)

2874 (YaTeX-reindent c))))

2875

2876 (defun yahtml-intelligent-newline-head ()

2877 (let ((title (read-string-with-history "Document title: "))

2878 (b "<title>") (e "</title>") p)

2879 (yahtml-indent-line)

2880 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2881 (setq p (point))

2882 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2883 (if (string= "" title) (goto-char p))

2884 (setq yahtml-last-begend "body")))

2885

2886 (defun yahtml-intelligent-newline-script ()

2887 (let ((p (point)) b)

2888 (if (save-excursion

2889 (and

2890 (setq b (re-search-backward "<script\\>" nil t))

2891 (re-search-forward

2892 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2893 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2894 c (srcp (re-search-backward "src=" b t)))

2895 (goto-char p)

2896 (yahtml-indent-line)

2897 (setq c (current-column))

2898 (if srcp

2899 nil

2900 (insert "")

2901 (beginning-of-line)

2902 (open-line 1)

2903 (YaTeX-reindent c))))))

2904

2905 (defun yahtml-intelligent-newline-table ()

2906 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2907 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2908 (cond

2909 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2910 (while (and (setq rb (re-search-backward ptn tb t))

2911 (match-beginning 1))

2912 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2913 (goto-char (match-end 0))

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

2915 (if (and (search-forward "colspan\\s *=" p t)

2916 (progn

2917 (skip-chars-forward "\"' \t\n")

2918 (looking-at "[0-9]+")))

2919 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2920 (setq cols (1+ cols)))

2921 (goto-char rb)

2922 (setq p (point)))

2923 (if (> cols 0)

2924 (message "%s columns found. %s"

2925 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2926 "New tr?(N) or Duplicate")))

2927 (cond

2928 ((and (> cols 0)

2929 (memq (read-char) '(?d ?D))) ;Duplication mode

2930 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2931 (t ;empty cells

2932 (setq line "<tr>" i 0)

2933 (if (> cols 0)

2934 (while (> cols i)

2935 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2936 "<td></td>"))

2937 th nil i (1+ i)))

2938 (setq fmt (read-string-with-history

2939 "`th' or `td' format: " "th td td"))

2940 (while (string-match "t\$h\$\\|td" fmt i)

2941 (setq line (concat line (if (match-beginning 1) "<th></th>"

2942 "<td></td>"))

2943 i (match-end 0))))

2944 (setq line (concat line "</tr>"))))

2945 (goto-char cp)

2946 (if th

2947 (message

2948 "Type `%s' to change td from/to th."

2949 (key-description (car (where-is-internal 'yahtml-change-*)))))

2950 (if (string< "" line)

2951 (progn

2952 (insert line)

2953 (goto-char (+ 8 cp))

2954 (yahtml-indent-line)))))))

2955

2956 ;;; ---------- Marking ----------

2957 (defun yahtml-mark-begend ()

2958 "Mark current tag"

2959 (interactive)

2960 (YaTeX-beginning-of-environment)

2961 (let ((p (point)))

2962 (save-excursion

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

2964 (if (bolp) (setq p (point))))

2965 (push-mark p t))

2966 (yahtml-goto-corresponding-begend)

2967 (forward-list 1)

2968 (if (eolp) (forward-char 1)))

2969

2970 ;;; ---------- complete marks ----------

2971 (defun yahtml-complete-mark ()

2972 "Complete &gt, &lt, &ampersand, and &quote."

2973 (interactive)

2974 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2975 (let ((c (read-char)))

2976 (setq c (if (or (< c ?0) (> c ?7))

2977 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2978 (- c ?1)))

2979 (if (or (< c 0) (> c 6))

2980 nil

2981 (insert (format "&%s;"

2982 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2983

2984

2985 ;;; ---------- jump to error line ----------

2986 (defun yahtml-prev-error ()

2987 "Jump to previous error seeing lint buffer."

2988 (interactive)

2989 (or (get-buffer yahtml-lint-buffer)

2990 (error "No lint program ran."))

2991 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2992 (yahtml-jump-to-error-line t))

2993

2994 (defun yahtml-jump-to-error-line (&optional sit)

2995 (interactive "P")

2996 (let ((p (point)) (e (point-end-of-line)))

2997 (end-of-line)

2998 (if (re-search-backward yahtml-error-line-regexp nil t)

2999 (let ((f (if (string= "" (YaTeX-match-string 1))

3000 YaTeX-current-file-name

3001 (YaTeX-match-string 1)))

3002 (l (string-to-int (or (YaTeX-match-string 2)

3003 (YaTeX-match-string 3)))))

3004 (if sit (sit-for 1))

3005 (forward-line -1)

3006 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

3007 (goto-line l))

3008 (message "No line number usage"))))

3009

3010 ;;; ---------- Style Sheet Support ----------

3011 (defvar yahtml-css-class-alist nil

3012 "Alist of elements vs. their classes")

3013

3014 (defun yahtml-css-collect-classes-region (beg end &optional initial)

3015 (save-excursion

3016 (save-restriction

3017 (narrow-to-region beg end)

3018 (goto-char (point-min))

3019 (let ((alist initial) b e element class a)

3020 (setq b (point))

3021 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

3022 (if (match-beginning 2)

3023 (let ((f (YaTeX-buffer-substring

3024 (progn (skip-chars-forward "^\"")(1+ (point)))

3025 (progn (forward-char 1)

3026 (skip-chars-forward "^\"")(point)))))

3027 (if (file-exists-p f)

3028 (setq alist

3029 (append alist (yahtml-css-collect-classes-file

3030 f initial)))))

3031 (setq e (point))

3032 (goto-char b)

3033 (while (re-search-forward ;ちょといい加減なREGEXP

3034 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

3035 e t)

3036 (setq element (YaTeX-match-string 1)

3037 class (YaTeX-match-string 2))

3038 ;;if starts with period (match-string 1 is nil),

3039 ;;this is global class

3040 (setq element (downcase (or element "*")))

3041 (if (setq a (assoc element alist))

3042 (or (assoc class (cdr a))

3043 (setcdr a (cons (list class) (cdr a))))

3044 (setq alist (cons (list element (list class)) alist))))

3045 (goto-char (1- e))

3046 (search-forward "}" nil 1) ;1=move to limit when not found.

3047 (setq b (point))))

3048 alist))))

3049

3050 (defun yahtml-css-collect-classes-buffer (&optional initial)

3051 (interactive)

3052 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

3053

3054 (defun yahtml-css-collect-classes-file (file &optional initial)

3055 (let*((hilit-auto-highlight nil)

3056 (buf (get-buffer-create

3057 (format " *css-collection*%s" (file-name-nondirectory file))))

3058 (cb (current-buffer)))

3059 (unwind-protect

3060 (progn

3061 (set-buffer buf)

3062 (insert-file-contents file)

3063 (cd (or (file-name-directory file) "."))

3064 (yahtml-css-collect-classes-buffer initial))

3065 (if (eq buf cb)

3066 nil

3067 (kill-buffer buf)

3068 (set-buffer cb)))))

3069

3070 (defun yahtml-css-scan-styles ()

3071 (save-excursion

3072 (goto-char (point-min))

3073 (set (make-local-variable 'yahtml-css-class-alist) nil)

3074 (let (b tag type e href alist)

3075 (while (re-search-forward "<\$style\\|link\$" nil t)

3076 (setq b (match-beginning 0)

3077 tag (YaTeX-match-string 1))

3078 (cond

3079 ((string-match "style" tag)

3080 (goto-char b)

3081 (save-excursion (forward-list 1) (setq e (point)))

3082 (cond

3083 ((search-forward "text/css" e 1) ;css definition starts

3084 (setq alist

3085 (yahtml-css-collect-classes-region

3086 (point) (progn (search-forward "</style>") (point))

3087 alist)))))

3088 ((and (string-match "link" tag)

3089 (stringp (setq type (yahtml-get-attrvalue "type")))

3090 (string-match "text/css" type)

3091 (setq href (yahtml-get-attrvalue "href"))

3092 (file-exists-p (yahtml-url-to-path href)))

3093 (setq alist

3094 (yahtml-css-collect-classes-file

3095 (yahtml-url-to-path href) alist))))

3096 (setq yahtml-css-class-alist alist)))))

3097

3098 (defun yahtml-css-get-element-completion-alist (element)

3099 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3100 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3101 (and (or alist global)

3102 (append alist global))))

3103

3104 ;;; ---------- ----------

3105

3106 ;;;

3107 ;;hilit19

3108 ;;;

3109 (defvar yahtml-default-face-table

3110 '(

3111 (form black/ivory white/hex-442233 italic)

3112 ))

3113 (defvar yahtml-hilit-patterns-alist

3114 '(

3115 'case-fold

3116 ;; comments

3117 ("" comment)

3118 ;; include&exec

3119 ("" include)

3120 ;; string

3121 (hilit-string-find ?\\ string)

3122 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3123 ("</?[uod]l>" 0 decl)

3124 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3125 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3126 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3127 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3128 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3129 ))

3130

3131 (defun yahtml-hilit-region-tag (tag)

3132 "Return list of start/end point of <TAG> form."

3133 (if (re-search-forward tag nil t)

3134 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3135 (elm (YaTeX-match-string 1)))

3136 (skip-chars-forward "^>")

3137 (prog1

3138 (cons (1+ (point))

3139 (progn (re-search-forward (concat "</" elm ">") nil t)

3140 (match-beginning 0)))

3141 (goto-char e0)))))

3142

3143 (defun yahtml-hilit-region-tag-itself (ptn)

3144 "Return list of start/end point of <tag options...> itself."

3145 (if (re-search-forward ptn nil t)

3146 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3147 (skip-chars-forward "^<>")

3148 (if (eq (char-after (point)) ?<) nil

3149 (prog1

3150 (cons m0 (min (point-max) (1+ (point))))

3151 (goto-char e0))))))

3152

3153 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3154 (and yahtml-use-hilit19

3155 (or (assq 'yahtml-mode hilit-patterns-alist)

3156 (setq hilit-patterns-alist

3157 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3158 hilit-patterns-alist))))

3159 ;;;

3160 ;; for font-lock

3161 ;;;

3162

3163 ; <<STATIC KEYWORDS BELOW NOT USED>>

3164 ;(defvar yahtml-font-lock-keywords

3165 ; '(

3166 ; ;; comments

3167 ; ("" . font-lock-comment-face)

3168 ; ;; include&exec

3169 ; (""

3170 ; 0 font-lock-include-face keep)

3171 ; ;; string

3172 ; ;(hilit-string-find ?\\ string)

3173 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3174 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3175 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3176 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3177 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3178 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3179 ; )

3180 ; "*Defualt font-lock-keywords for yahtml-mode.")

3181 (defvar yahtml-font-lock-keywords

3182 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3183 "Default fontifying patterns for yahtml-mode")

3184

3185 (defun yahtml-font-lock-set-default-keywords ()

3186 (put 'yahtml-mode 'font-lock-defaults

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

3188

3189 (if yahtml-use-font-lock

3190 (progn

3191 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3192 ;;for those who use both hilit19 and font-lock

3193 (if (eq (car hilit-mode-enable-list) 'not)

3194 (or (member 'yahtml-mode hilit-mode-enable-list)

3195 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3196 (setq hilit-mode-enable-list

3197 (delq 'yahtml-mode hilit-mode-enable-list))))

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

3199

3200 (defun yahtml-font-lock-recenter (&optional arg)

3201 (interactive "P")

3202 (font-lock-mode -1) ;is stupid, but sure.

3203 (font-lock-mode 1))

3204

3205 ;;;

3206 ;; Drag-n-Drop

3207 ;;;

3208 (defun yahtml-dnd-handler (uri action)

3209 "DnD handler for yahtml mode

3210 Convert image URI to img-src and others to a-href."

3211 (let*((file (dnd-get-local-file-name uri))

3212 (path (if file (file-relative-name file) uri))

3213 (case-fold-search t)

3214 (geom ""))

3215 (cond

3216 ((memq action '(copy link move private))

3217 (cond

3218 ((string-match "\\.\$jpe?g\\|png\\|gif\\|bmp\\|tiff?\$$" path)

3219 (if file

3220 (setq geom (yahtml-get-image-info path)

3221 geom (if (car geom)

3222 (apply 'format " width=\"%s\" height=\"%s\"" geom)

3223 "")))

3224 (insert (format "<img src=\"%s\" alt=\"%s\"%s>"

3225 path (file-name-nondirectory path) geom)))

3226

3227 (t (insert (format "<a href=\"%s\"></a>" path))

3228 (forward-char -4))))

3229 (t (message "No handler for action `%s'" action))))

3230 action)

3231

3232 (run-hooks 'yahtml-load-hook)

3233 (provide 'yahtml)

3234

3235 ; Local variables:

3236 ; fill-prefix: ";;; "

3237 ; paragraph-start: "^$\\|\\|;;;$"

3238 ; paragraph-separate: "^$\\|\\|;;;$"

3239 ; coding: sjis

3240 ; End: