yatex: d3bcc4e2166a yahtml.el

yatex

view yahtml.el @ 154:d3bcc4e2166a

Two new function added. `[prefix] }' yahtml-td-region `[prefix] ]' yahtml-tr-region

author	yuuji@gentei.org
date	Thu, 09 Dec 2010 12:23:22 +0900
parents	207f0b4af9df
children	4fd09665b2be

line source

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

3 ;;; Last modified Thu Dec 9 12:21:27 2010 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.74.2"

7 "Revision number of running yahtml.el")

9 ;;;[Installation]

10 ;;;

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

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

13 ;;;

14 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

23 ;;;

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

25 ;;;

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

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

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

29 ;;;

30 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

39 ;;;

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

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

42 ;;;

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

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

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

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

47 ;;;

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

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

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

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

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

53 ;;;

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

55 ;;;

56 ;;;[Commentary]

57 ;;;

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

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

60 ;;;

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

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

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

64 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

89 ;;; change the reference link with completion.

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

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

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

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

94 ;;; is "firefox")

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

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

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

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

99 ;;; in the region.

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

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

102 ;;; URLencoded string in the region.

103 ;;;

104 ;;;[キーの説明]

105 ;;;

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

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

108 ;;;

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

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

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

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

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

114 ;;; できます。

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

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

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

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

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

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

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

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

123 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

135 ;;; す。

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

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

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

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

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

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

142 ;;; きます。

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

144 ;;; す。

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

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

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

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

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

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

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

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

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

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

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

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

157 ;;;

158 ;;; [謝辞]

159 ;;;

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

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

162 ;;;

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

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

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

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

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

168 ;;;

169

170

171 (require 'yatexlib)

172 ;;; --- customizable variable starts here ---

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

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

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

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

177 (defvar yahtml-kanji-code 2

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

179 ;;(defvar yahtml-coding-system

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

181 ;; "Kanji coding system")

182 (and (featurep 'mule)

183 (integerp yahtml-kanji-code)

184 (setq yahtml-kanji-code

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

186

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

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

189

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

191 (defvar yahtml-path-url-alist nil

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

193 Ex.

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

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

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

197 "*Directory index file name;

198 Consult your site's WWW administrator.")

199

200 (defvar yahtml-environment-indent 1

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

202

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

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

205 "*Program name to lint HTML file")

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

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

208

209 (defvar yahtml-always-/p t

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

211 (defvar yahtml-always-/li nil

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

213 (defvar yahtml-always-/dt nil

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

215 (defvar yahtml-always-/dd nil

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

217

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

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

220

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

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

223

224 (defvar yahtml-prefer-upcases nil

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

226

227 (defvar yahtml-prefer-upcase-attributes nil

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

229

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

231

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

233 "*Server access file name for apache")

234

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

236

237 (defvar yahtml-image-inspection-bytes 50000

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

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

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

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

242 %f: filename")

243

244 (defvar yahtml-faithful-to-htmllint nil)

245 (defvar yahtml-error-line-regexp

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

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

248

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

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

251 (defvar yahtml-escape-chars 'ask

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

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

254 at each reserved chars.")

255

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

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

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

259

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

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

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

263

264 (defvar yahtml-mode-abbrev-table nil

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

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

267

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

269 "*Boundary regexp for indentation calculation.")

270

271 (defvar yahtml-html4-strict t

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

273 Completing read for obsoleted attributes disabled.")

274

275 ;;; --- customizable variable ends here ---

276 (defvar yahtml-prefix-map nil)

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

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

279 (defvar yahtml-shell-command-option

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

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

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

283

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

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

286 (YaTeX-define-key

287 key

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

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

290 map))

291

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

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

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

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

296

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

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

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

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

301 (if YaTeX-inhibit-prefix-letter nil

302 (yahtml-define-begend-region-key

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

304

305 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

318 (let ((map yahtml-prefix-map))

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

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

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

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

323 (and YaTeX-emacs-19 window-system

324 (progn

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

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

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

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

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

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

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

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

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

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

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

336 (if YaTeX-no-begend-shortcut

337 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

376 (substitute-all-key-definition

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

378 (substitute-all-key-definition

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

380

381 (if yahtml-lint-buffer-map nil

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

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

384

385

386 (defvar yahtml-paragraph-start

387 (concat

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

389 "*Regexp of html paragraph separater")

390 (defvar yahtml-paragraph-separate

391 (concat

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

393 "*Regexp of html paragraph separater")

394 (defvar yahtml-syntax-table nil

395 "*Syntax table for yahtml-mode")

396

397 (if yahtml-syntax-table nil

398 (setq yahtml-syntax-table

399 (make-syntax-table (standard-syntax-table)))

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

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

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

403

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

405 "Regexp of constituent of html commands.")

406

407 ;;; Completion tables for `form'

408 (defvar yahtml-form-table

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

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

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

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

413

414 (defvar yahtml-env-table

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

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

417 ("OrderedList" . "ol")

418 ("UnorderedList" . "ul")

419 ("DefinitionList" . "dl")

420 ("Preformatted" . "pre")

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

422 ("address") ("button")

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

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

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

426 ))

427

428 (if yahtml-html4-strict

429 (setq yahtml-env-table

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

431

432 ;(defvar yahtml-itemizing-regexp

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

434 ; "Regexp of itemizing forms")

435

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

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

438

439 ;;; Completion tables for typeface designator

440 (and yahtml-always-/p

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

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

443 (and yahtml-always-/li

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

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

446 (and yahtml-always-/dt

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

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

449 (and yahtml-always-/dd

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

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

452

453 (defvar yahtml-typeface-table

454 (append

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

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

457 ("sup") ("sub") ("span") ("abbr"))

458 (if (not yahtml-html4-strict)

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

460 yahtml-env-table)

461 "Default completion table of typeface designator")

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

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

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

465

466 (defvar yahtml-single-cmd-table

467 '(("hr") ("br") ("option")

468 ("HorizontalRule" . "hr")

469 ("BreakLine" . "br")

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

471 ("!--#exec")

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

473 ("!--#include")

474 ;; ("Item" . "li")

475 ;; ("DefineTerm" . "dt")

476 ;; ("Description" . "dd")

477 ;; ("dd") ("dt") ("li")

478 )

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

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

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

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

483

484 (defvar yahtml-current-completion-type nil

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

486

487 (defvar yahtml-struct-name-regexp

488 (concat

489 "\\<\\("

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

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

492 "\\)\\b")

493 "Regexp of structure beginning.")

494

495 (defvar yahtml-closable-regexp

496 (concat

497 "\\<\\("

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

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

500 "\\)\\b")

501 "Regexp of any closable elemnts.")

502

503 (defvar yahtml-indent-listing-constant t

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

505 T for static indentation depth")

506

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

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

509

510

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

512 (cond

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

514 buffer-file-name)

515 (let ((dir default-directory)

516 charset af ext (ldir "")

517 line

518 (case-fold-search t)

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

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

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

522 (while (and dir

523 (not (string= dir ldir))

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

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

526 (if (file-exists-p af)

527 (save-excursion

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

529 (save-excursion

530 (goto-char (point-min))

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

532 (setq line (buffer-substring

533 (point-beginning-of-line)

534 (point-end-of-line))

535 dir nil)))

536 (kill-buffer (current-buffer))))

537 (if dir

538 (setq ldir dir

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

540 dir (file-name-directory dir))))

541 line))

542 (t nil)))

543

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

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

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

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

548 (case-fold-search t)

549 line

550 charset)

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

552 (progn

553 (string-match ptn line)

554 (setq charset

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

556 (cond

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

558 (setq charset 2))

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

560 (setq charset 3))

561 ((string-match "shift_jis" charset)

562 (setq charset 1))

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

564 (setq charset 4))

565 (t (setq charset nil)))

566 (setq dir "")))

567 (if (featurep 'mule)

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

569 charset))

570

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

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

573 x index-list)

574 ;;s/\\s *$//;

575 (if line

576 (progn

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

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

579 (while (string< "" line)

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

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

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

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

584 line "")))

585 (or (nreverse index-list)

586 (if (listp yahtml-directory-index)

587 yahtml-directory-index

588 (list yahtml-directory-index)))))))

589

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

591 (defun yahtml-mode ()

592 (interactive)

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

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

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

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

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

598 (cond

599 ((null coding) nil)

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

601 (setq buffer-file-coding-system

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

603 (save-excursion

604 (goto-char (point-min))

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

606 coding)))

607 ((featurep 'mule)

608 (set-file-coding-system coding))

609 ((boundp 'NEMACS)

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

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

612 (setq major-mode 'yahtml-mode

613 mode-name "yahtml"

614 YaTeX-current-file-name (file-name-nondirectory

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

616 local-abbrev-table yahtml-mode-abbrev-table)

617 (mapcar

618 (function (lambda (x)

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

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

621 (boundp (cdr x)))

622 (symbol-value (cdr x))

623 (cdr x)))))

624 '((YaTeX-ec . "")

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

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

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

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

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

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

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

632 (paragraph-start . yahtml-paragraph-start)

633 (paragraph-separate . yahtml-paragraph-separate)

634 (comment-start . "")

635 (comment-start-skip . comment-start)

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

637

638 (if yahtml-use-font-lock

639 (progn

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

641 (or (featurep 'xemacs)

642 (progn

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

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

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

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

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

648 (font-lock-fontify-buffer)))))

649 (set-syntax-table yahtml-syntax-table)

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

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

652 (yahtml-css-scan-styles)

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

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

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

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

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

658

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

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

661 font-lock-defaults)

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

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

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

665

666 (defun yahtml-version ()

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

668 (interactive)

669 (message

670 (concat "Yet Another HTML-mode "

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

672 " Revision "

673 yahtml-revision-number)))

674

675 (defun yahtml-quit ()

676 (interactive)

677 (and yahtml-mode-old-mode

678 (fboundp yahtml-mode-old-mode)

679 (funcall yahtml-mode-old-mode)))

680

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

682 (cond

683 ((featurep 'xemacs)

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

685 (set keymap nil)

686 (mapcar

687 (function

688 (lambda (bind)

689 (setq bind (cdr bind))

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

691 (setcar (cdr bind) 'progn))

692 (if (stringp (car (cdr bind)))

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

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

695 (symbol-value keymap))))))

696 bindlist)

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

698 (t

699 (mapcar

700 (function

701 (lambda (bind)

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

703 bindlist))))

704

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

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

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

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

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

710

711 ;;; Variables for mosaic url history

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

713 (defvar yahtml-urls-private nil)

714 (defvar yahtml-urls-local nil)

715

716 (cond

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

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

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

720 (YaTeX-define-menu

721 'yahtml-menu-map-sectioning

722 (nreverse

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

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

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

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

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

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

729 )))

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

731 (YaTeX-define-menu

732 'yahtml-menu-map-logical

733 (nreverse

734 '((em "Embolden" .

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

736 (dfn "Define a word" .

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

738 (cite "Citation" .

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

740 (code "Code" .

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

742 (kbd "Keyboard" .

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

744 (samp "Sample display" .

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

746 (strong "Strong" .

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

748 (VAR "Variable notation" .

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

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

751 (YaTeX-define-menu

752 'yahtml-menu-map-typeface

753 (nreverse

754 '((b "Bold" .

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

756 (i "Italic" .

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

758 (tt "Typewriter" .

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

760 (u "Underlined" .

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

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

763 (YaTeX-define-menu

764 'yahtml-menu-map-listing

765 (nreverse

766 '((ul "Unordered" .

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

768 (ol "Ordered" .

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

770 (dl "Definition" .

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

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

773 (YaTeX-define-menu

774 'yahtml-menu-map-item

775 (nreverse

776 '((li "Simple item" .

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

778 (dt "Define term" .

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

780 (dd "Description of term" .

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

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

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

784 (YaTeX-define-menu

785 'yahtml-menu-map

786 (nreverse

787 (list

788 (cons (list 'sect "Sectioning")

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

790 (cons (list 'list "Listing")

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

792 (cons (list 'item "Item")

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

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

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

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

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

798 (if (featurep 'xemacs)

799 (add-hook 'yahtml-mode-hook

800 '(lambda ()

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

802 (progn

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

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

805

806 ;;; ----------- Completion ----------

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

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

809 "Insert <cmd> ... </cmd>."

810 (interactive "P")

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

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

813 (cmd

814 (or env

815 (YaTeX-cplread-with-learning

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

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

818 (bolp (save-excursion

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

820 (cc (current-column)))

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

822 (setq yahtml-last-begend

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

824 yahtml-last-begend))

825 (setq cmd yahtml-last-begend)

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

827 (if region

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

829 ;; to enable continuous regioning by another environment

830 (let ((beg (region-beginning))

831 (end (region-end))

832 (addin (yahtml-addin cmd)))

833 (save-excursion

834 (goto-char end)

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

836 (goto-char beg)

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

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

839 (save-excursion

840 (insert "\n")

841 (indent-to-column cc)

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

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

844 (newline)

845 (yahtml-intelligent-newline nil))

846 (yahtml-indent-line))))

847

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

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

850 (interactive)

851 (yahtml-insert-begend t))

852

853

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

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

856 (interactive)

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

858 (or form

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

860 (setq form

861 (YaTeX-cplread-with-learning

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

863 'yahtml-form-table 'yahtml-user-form-table

864 'yahtml-tmp-form-table))))

865 (let ((p (point)) q)

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

867 (setq yahtml-last-form form)

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

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

870 ;;(indent-relative-maybe)

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

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

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

874

875 (defun yahtml-read-css (alist)

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

877 (minibuffer-completion-table alist))

878 (read-from-minibuffer

879 (substitute-command-keys

880 (if YaTeX-japan

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

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

883 nil YaTeX-minibuffer-completion-map nil)))

884

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

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

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

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

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

890 (defun yahtml-newpage (file ov)

891 "Create newpage via newpage script"

892 (interactive

893 (list

894 (let (insert-default-directory)

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

896 current-prefix-arg))

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

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

899 (insert (substring

900 (YaTeX-command-to-string

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

902 0 -1)))

903

904 ;;; ---------- Add-in ----------

905 (defun yahtml-addin (form)

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

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

908 (concat

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

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

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

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

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

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

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

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

917 (string< "" s))

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

919 ""))))

920

921 (defvar yahtml-completing-buffer nil)

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

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

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

925 (let (list end)

926 (save-excursion

927 (set-buffer yahtml-completing-buffer)

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

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

930 (save-excursion

931 (goto-char (point-min))

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

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

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

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

936 (setq end (match-end 0))

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

938 (yahtml-on-assignment-p)

939 (progn

940 (goto-char end)

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

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

943 (setq list (cons

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

945 list))))

946 list))))

947

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

949 (if yahtml-url-completion-map nil

950 (setq yahtml-url-completion-map

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

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

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

954

955 (defun yahtml-complete-url ()

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

957 (interactive)

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

959 (lim (YaTeX-minibuffer-begin))

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

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

962 (cond

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

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

965 listfunc (list 'lambda nil

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

967 beg min))

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

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

970 (progn

971 (setq path (substring initial 0 beg))

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

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

974 (setq initial (substring initial beg))

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

976 cmpl (try-completion initial labels)

977 listfunc (list 'lambda ()

978 (list 'all-completions

979 initial (list 'quote labels)))

980 beg (+ min beg)))

981 (t

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

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

984 initial))

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

986 file (file-name-nondirectory path)

987 initial file

988 cmpl (file-name-completion file dir)

989 listfunc (list 'lambda nil

990 (list 'file-name-all-completions

991 file dir))

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

993 (cond

994 ((stringp cmpl)

995 (if (string= initial cmpl)

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

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

998 (princ

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

1000 (delete-region (point) beg)

1001 (insert cmpl)))

1002 ((null cmpl)

1003 (ding))

1004 ((eq t cmpl)

1005 (save-excursion

1006 (unwind-protect

1007 (progn

1008 (goto-char p)

1009 (insert " [Sole completion]"))

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

1011

1012 ;

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

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

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

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

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

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

1019 ;

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

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

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

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

1024 (defvar yahtml-unsafe-chars-regexp

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

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

1027 ;

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

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

1030 ;

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

1032 ; "$" | ","

1033 (defvar yahtml-unreserved-chars-regexp

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

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

1036 Not used yet.")

1037

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

1039 "Translate reserved chars to URL encoded string."

1040 (let ((p 0) (target "")

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

1042 (cond

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

1044 (t

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

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

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

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

1049 (setq target (concat target

1050 (substring str 0 p)

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

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

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

1054 (concat target str)))))

1055

1056 (defun yahtml-unescape-string (str)

1057 "Untranslate reserved URL-encoded string."

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

1059 (unwind-protect

1060 (progn

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

1062 (setq target (concat target

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

1064 p (match-end 0)

1065 c (YaTeX-hex (substring

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

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

1068 (concat target (substring str p)))

1069 (store-match-data md))))

1070

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

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

1073 (interactive "r")

1074 (save-excursion

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

1076 (goto-char beg)

1077 (while (and (< (point) e)

1078 (re-search-forward

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

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

1081 (sit-for 0)

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

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

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

1085 ; (unwind-protect

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

1087 ; (save-excursion

1088 ; (backward-char 1)

1089 ; (delete-backward-char 4))

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

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

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

1093 (progn

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

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

1096 (set-marker e nil))))

1097 ;; ab%defgls/.|

1098

1099 (defun yahtml:a ()

1100 "Add-in function for <a>"

1101 (let ((href ""))

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

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

1104 href (yahtml-escape-chars-string

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

1106 (prog1

1107 (concat (yahtml-make-optional-argument

1108 "href" href)

1109 (yahtml-make-optional-argument

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

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

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

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

1114 (YaTeX-update-table

1115 (list href)

1116 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1117

1118 (defvar yahtml-parameters-completion-alist

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

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

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

1122 ("src" . file) ("file" . file)

1123 ("background" . file)

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

1125 ("method" ("POST") ("GET"))

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

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

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

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

1130 ("http-equiv" ("Refresh"))))

1131

1132 (defvar yahtml-link-types-alist

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

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

1135 ("subsection") ("appendix") ("help") ("bookmark")))

1136

1137 (defvar yahtml-content-types-alist

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

1139 ("text/sgml") ("text/xml")

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

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

1142 ("application/java")

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

1144 "Alist of content-types")

1145

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

1147 (let* ((alist

1148 (cdr-safe (assoc (downcase par)

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

1150 (prompt (concat par ": "))

1151 v)

1152 (cond

1153 ((eq alist 'file)

1154 (let ((insert-default-directory))

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

1156 ((eq alist 'command)

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

1158 (read-shell-command prompt)

1159 (read-string prompt)))

1160 ((and alist (symbolp alist))

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

1162 (alist

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

1164 (t

1165 (read-string prompt default)))))

1166

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

1168 "Make optional argument string."

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

1170 ""

1171 (concat " "

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

1173 "=\"" arg "\"")))

1174

1175 (defun yahtml:html ()

1176 "Add-in for <html>"

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

1178 (yahtml-make-optional-argument

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

1180

1181 (defun yahtml:head ()

1182 "Add-in for <head>"

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

1184 "")

1185

1186 (defun yahtml:body ()

1187 "Add-in function for <body>"

1188 (cond

1189 (yahtml-html4-strict nil)

1190 (t

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

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

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

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

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

1196 (concat

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

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

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

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

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

1202

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

1204 "Make CSS property definitions in style attribute."

1205 (mapconcat

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

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

1208 (delq nil proplist)

1209 " "))

1210

1211 (defun yahtml:img ()

1212 "Add-in function for <img>"

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

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

1215 alt

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

1217 (l yahtml-prefer-upcase-attributes)

1218 info width height bytes comments)

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

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

1221 (car info)

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

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

1224 bytes (car (cdr (cdr info)))

1225 comments (nth 4 info)))

1226 (if info

1227 (setq alt

1228 (YaTeX-replace-formats

1229 yahtml:img-default-alt-format

1230 (list (cons "x" width)

1231 (cons "y" height)

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

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

1234 (cons "c" (car comments))))))

1235

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

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

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

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

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

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

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

1243 (if yahtml-html4-strict

1244 (yahtml-make-optional-argument

1245 "style"

1246 (if (or brd alg)

1247 (yahtml-make-style-parameter

1248 (list

1249 (if (string< "" alg)

1250 (cons "align" alg))

1251 (if (string< "" brd)

1252 (cons "border"

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

1254 (concat

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

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

1257

1258 (defun yahtml-file-truename (file)

1259 (cond

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

1261 (t (let ((new file))

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

1263 (not (equal new file)))

1264 (setq file new))

1265 file))))

1266

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

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

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

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

1271 (let ((mlt 1)

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

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

1274 (value 0))

1275 (while (> length 0)

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

1277 pos (+ pos direc)

1278 mlt (* mlt 256)

1279 length (1- length)))

1280 value))

1281

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

1283 "Return the information on the image file FILE.

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

1285 (save-excursion

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

1287 width height bytes depth comment

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

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

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

1291 (seekpoint 1)

1292 c1 c2 c3 c4 beg end

1293 (case-fold-search nil))

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

1295 (set-buffer tmpbuf)

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

1297 (erase-buffer)

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

1299 (unwind-protect

1300 (progn

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

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

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

1304 (YaTeX-insert-file-contents

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

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

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

1308 c2 (char-after 2)

1309 c3 (char-after 3)

1310 c4 (char-after 4))

1311 (cond

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

1313 ;;JPEG images need JPEG markers inspection

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

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

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

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

1318 (catch 'exit

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

1320 (cond

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

1322 ;maybe corrupted, exit from loop

1323 (throw 'exit t))

1324 ((memq

1325 (char-after (1+ seekpoint))

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

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

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

1329 ;;found!

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

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

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

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

1334 ;; JPEG comment area

1335 (setq beg (+ seekpoint 2 2)

1336 end (+ seekpoint

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

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

1339 (t ;other markers

1340 nil)) ;just skip it

1341 (setq seekpoint (+ seekpoint 2)

1342 seekpoint (+ seekpoint

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

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

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

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

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

1348 height (yahtml-hex-value 20 4)

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

1350 ((looking-at "GIF8")

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

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

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

1354 ((looking-at "BM")

1355 ;;# OS/2, Windoze BMP files

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

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

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

1359 (cond

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

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

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

1363 (t

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

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

1366 (message "")

1367 (kill-buffer tmpbuf))

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

1369

1370 (defun yahtml:form ()

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

1372 (concat

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

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

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

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

1377

1378 (defun yahtml:select ()

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

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

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

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

1383

1384 (defun yahtml:ol ()

1385 "Add-in function for <ol>"

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

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

1388 (type (completing-read

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

1390 (concat

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

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

1393 (defun yahtml:ul ()

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

1395 (defun yahtml:dl ()

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

1397 (defun yahtml:dt ()

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

1399

1400 (defun yahtml:p ()

1401 (if yahtml-html4-strict nil

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

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

1404

1405 (defvar yahtml-input-types

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

1407 ("reset") ("image") ("hidden") ("file")))

1408

1409 (defun yahtml:input ()

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

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

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

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

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

1415 yahtml-input-types nil t)

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

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

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

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

1420 (concat

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

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

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

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

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

1426

1427 (defun yahtml:textarea ()

1428 "Add-in function for `textarea'"

1429 (interactive)

1430 (let (name rows cols)

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

1432 cols (read-string "Columns: ")

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

1434 (concat

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

1436 "\"" name "\"")

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

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

1439

1440 (defun yahtml:table ()

1441 "Add-in function for `table'"

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

1443 (a (yahtml-read-parameter

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

1445 (if yahtml-html4-strict

1446 (yahtml-make-optional-argument

1447 "style"

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

1449 (yahtml-make-style-parameter

1450 (append

1451 (if (string< "" b)

1452 (list

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

1454 (cons "border-collapse" "collapse")))

1455 (if (string< "" a)

1456 (cond

1457 ((string-match "right" a)

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

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

1460 ((string-match "center" a)

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

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

1463 (concat

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

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

1466

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

1468 (defun yahtml:caption ()

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

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

1471 (if yahtml-html4-strict

1472 (yahtml-make-optional-argument

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

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

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

1476

1477 (defun yahtml:font ()

1478 "Add-in function for `font'"

1479 (concat

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

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

1482

1483 (defun yahtml:style ()

1484 "Add-in function for `style'"

1485 (yahtml-make-optional-argument

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

1487

1488 (defun yahtml:script ()

1489 "Add-in function for `script'"

1490 (concat

1491 (yahtml-make-optional-argument

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

1493 (yahtml-make-optional-argument

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

1495

1496 (defun yahtml:tr ()

1497 "Add-in function for `tr'"

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

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

1500 "")

1501

1502 (defun yahtml:link ()

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

1504 (let (rel rev type href)

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

1506 (cond

1507 ((equal rel "")

1508 (concat (yahtml-make-optional-argument

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

1510 (yahtml-make-optional-argument

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

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

1513 )))

1514 ((string-match "stylesheet" rel)

1515 (concat

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

1517 (yahtml-make-optional-argument

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

1519 (progn

1520 (setq href

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

1522 (if (string< "" href)

1523 (progn

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

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

1526 (setq yahtml-css-class-alist

1527 (yahtml-css-collect-classes-file

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

1529 (message "")

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

1531 (t

1532 (concat

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

1534 (yahtml-make-optional-argument

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

1536 (yahtml-make-optional-argument

1537 "href"

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

1539

1540 (defvar yahtml:meta-names

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

1542

1543 (defun yahtml:meta ()

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

1545 "name"

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

1547 http-equiv content)

1548 (if (string= "" name)

1549 (if (string-match

1550 "Content-type"

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

1552 "http-equiv"

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

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

1555 "See docs/qanda")

1556 (concat http-equiv

1557 (yahtml-make-optional-argument

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

1559 (concat

1560 name

1561 (yahtml-make-optional-argument

1562 "content"

1563 (cond

1564 ((string-match "date" name)

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

1566 ((string-match "author" name)

1567 (read-string "Author: "

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

1569 (user-full-name)

1570 (user-login-name))))

1571 ((string-match "GENERATOR" name)

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

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

1574 (message "Thank you!"))

1575 content)

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

1577

1578 (defun yahtml:br ()

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

1580

1581 (defun yahtml:object ()

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

1583 data classid)

1584 (cond

1585 ((string-match "java" codetype)

1586 (let ((completion-ignored-extensions

1587 ;;any extensions except ".class"

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

1589 (setq classid (concat "java:"

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

1591 (concat

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

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

1594 (yahtml-make-optional-argument

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

1596 (yahtml-make-optional-argument

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

1598 (yahtml-make-optional-argument

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

1600 (t

1601 ""))))

1602

1603 (defun yahtml:abbr ()

1604 "Add-in function for abbr."

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

1606

1607 (defun yahtml:button ()

1608 (concat

1609 (yahtml-make-optional-argument

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

1611 (yahtml-make-optional-argument

1612 "type" (yahtml-read-parameter

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

1614 (yahtml-make-optional-argument

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

1616

1617 ;;; ---------- Simple tag ----------

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

1619 "Insert <TAG> </TAG> and put cursor inside of them."

1620 (interactive "P")

1621 (setq yahtml-current-completion-type 'inline)

1622 (or tag

1623 (let ((completion-ignore-case t))

1624 (setq tag

1625 (YaTeX-cplread-with-learning

1626 (format "Tag %s(default %s): "

1627 (if region-mode "region: " "") yahtml-last-typeface-cmd)

1628 'yahtml-typeface-table 'yahtml-user-typeface-table

1629 'yahtml-tmp-typeface-table))))

1630 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))

1631 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))

1632 (setq yahtml-last-typeface-cmd tag

1633 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))

1634 (if region-mode

1635 (if (if (string< "19" emacs-version) (mark t) (mark))

1636 (save-excursion

1637 (if (> (point) (mark)) (exchange-point-and-mark))

1638 (insert (format "<%s%s>" tag (yahtml-addin tag)))

1639 (exchange-point-and-mark)

1640 (insert "</" tag ">"))

1641 (message "No mark set now"))

1642 (insert (format "<%s%s>" tag (yahtml-addin tag)))

1643 (save-excursion (insert (format "</%s>" tag)))))

1644

1645 (defun yahtml-insert-tag-region (&optional tag)

1646 "Call yahtml-insert-tag with region mode."

1647 (interactive)

1648 (yahtml-insert-tag t tag))

1649

1650 (defvar yahtml-need-single-closer nil) ;for test

1651 (defun yahtml-insert-single (cmd)

1652 "Insert <CMD>."

1653 (interactive

1654 (list

1655 (let ((completion-ignore-case t))

1656 (YaTeX-cplread-with-learning

1657 (format "Command%s: "

1658 (if yahtml-last-single-cmd

1659 (concat "(default " yahtml-last-single-cmd ")") ""))

1660 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

1661 'yahtml-tmp-single-cmd-table))))

1662 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))

1663 (setq yahtml-last-single-cmd

1664 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))

1665 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)

1666 yahtml-last-single-cmd))

1667 (insert (format "<%s%s%s>"

1668 cmd

1669 (yahtml-addin cmd)

1670 (if (and yahtml-need-single-closer

1671 (assoc cmd '(("br")("hr"))))

1672 " /" "")))

1673 (if (assoc cmd yahtml-env-table)

1674 (save-excursion (insert (format "</%s>" cmd)))))

1675

1676 (defun yahtml-insert-p (&optional arg)

1677 "Convenient function to insert <p></p>"

1678 (interactive "P")

1679 (if (or yahtml-always-/p arg) (yahtml-insert-tag arg "p")

1680 (yahtml-insert-single "p")))

1681

1682 (defun yahtml-insert-amps (arg)

1683 "Insert char-entity references via ampersand"

1684 ;; Thanks; http://www.tsc.co.jp/~asada/html/wdg40_f/entities/

1685 (interactive "P")

1686 (let*((mess "") c

1687 (list (append yahtml-entity-reference-chars-alist-default

1688 yahtml-entity-reference-chars-alist))

1689 (l list))

1690 (while l

1691 (setq mess (format "%s %c" mess (car (car l)) (cdr (car l)))

1692 l (cdr l)))

1693 (message "Char-entity reference: %s SPC=& RET=&; Other=&#..;" mess)

1694 (setq c (read-char))

1695 (cond

1696 ((equal c (car-safe (assoc c list)))

1697 (insert (format "&%s;" (cdr (assoc c list)))))

1698 ((or (equal c ?\n) (equal c ?\r))

1699 (insert "&;")

1700 (forward-char -1))

1701 ((equal c ? )

1702 (insert ?&))

1703 (t (insert (format "&#%d;" c))))))

1704

1705 (defun yahtml:!--\#include ()

1706 (let ((file (yahtml-read-parameter "file" "")))

1707 (format "%s=\"%s\"--" (if (string-match "/" file) "virtual" "file") file)))

1708

1709 (defun yahtml:!--\#exec ()

1710 (format "cmd=\"%s\"--"

1711 (yahtml-read-parameter "cmd" "" '(("cmd" . command)))))

1712

1713 ;;; ---------- Jump ----------

1714 (defun yahtml-on-href-p ()

1715 "Check if point is on href clause."

1716 (let ((p (point)) e cmd (case-fold-search t))

1717 (save-excursion

1718 (and ;;(string= (YaTeX-inner-environment t) "a") ;aでなくても許可にした

1719 (save-excursion

1720 ;;(search-forward "</a>" nil t) ;aでなくても許可にした

1721 (search-forward "[\" \t\n]" nil t)

1722 (setq e (point)))

1723 ;(goto-char (get 'YaTeX-inner-environment 'point))

1724 (re-search-backward "<\$a\\|link\$\\>" nil t)

1725 (search-forward "href" e t)

1726 (search-forward "=" e t)

1727 (progn

1728 (skip-chars-forward " \t\n")

1729 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

1730 (< p (match-end 0))

1731 (yahtml-unescape-string (YaTeX-match-string 1))))))

1732

1733 (defun yahtml-netscape-sentinel (proc mes)

1734 (cond

1735 ((null (buffer-name (process-buffer proc)))

1736 (set-process-buffer proc nil))

1737 ((eq (process-status proc) 'exit)

1738 (let ((cb (current-buffer)))

1739 (set-buffer (process-buffer proc))

1740 (goto-char (point-min))

1741 (if (search-forward "not running" nil t)

1742 (progn

1743 (message "Starting netscape...")

1744 (start-process

1745 "browser" (process-buffer proc)

1746 shell-file-name yahtml-shell-command-option

1747 (format "%s \"%s\"" yahtml-www-browser

1748 (get 'yahtml-netscape-sentinel 'url)))

1749 (message "Starting netscape...Done")))

1750 (set-buffer cb)))))

1751

1752 (defvar yahtml-browser-process nil)

1753

1754 (defun yahtml-browse-html (href)

1755 "Call WWW Browser to see HREF."

1756 (let ((pb "* WWW Browser *") (cb (current-buffer)))

1757 (cond

1758 ((string-match "^start\\>" yahtml-www-browser)

1759 (if (get-buffer pb)

1760 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1761 (put 'yahtml-netscape-sentinel 'url href)

1762 (set-process-sentinel

1763 (setq yahtml-browser-process

1764 (start-process

1765 "browser" pb shell-file-name yahtml-shell-command-option

1766 (format "%s \"%s\"" yahtml-www-browser href)))

1767 'yahtml-netscape-sentinel))

1768 ((and (string-match

1769 "[Nn]etscape\\|[Ff]irefox\\|[Mm]ozilla" yahtml-www-browser)

1770 (not (eq system-type 'windows-nt)))

1771 (if (get-buffer pb)

1772 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

1773 (put 'yahtml-netscape-sentinel 'url href)

1774 (set-process-sentinel

1775 (setq yahtml-browser-process

1776 (start-process

1777 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

1778 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))

1779 'yahtml-netscape-sentinel))

1780 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))

1781 (w3-fetch href))

1782 ((stringp yahtml-www-browser)

1783 (if (and yahtml-browser-process

1784 (eq (process-status yahtml-browser-process) 'run))

1785 (message "%s is already running" yahtml-www-browser)

1786 (setq yahtml-browser-process

1787 (start-process

1788 "browser" "* WWW Browser *"

1789 shell-file-name yahtml-shell-command-option

1790 (format "%s \"%s\"" yahtml-www-browser href)))))

1791 (t

1792 (message "Sorry, jump across http is not supported.")))))

1793

1794 (defun yahtml-goto-corresponding-href (&optional other)

1795 "Go to corresponding name."

1796 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))

1797 (if href

1798 (cond

1799 ((string-match "^\$ht\\|f\$tps?:" href)

1800 (yahtml-browse-html href))

1801 (t (setq file (substring href 0 (string-match "#" href)))

1802 (if (string-match "#" href)

1803 (setq name (substring href (1+ (string-match "#" href)))))

1804 (if (string< "" file)

1805 (progn

1806 (if (string-match "/$" file)

1807 (or (catch 'dirindex

1808 (mapcar

1809 (function

1810 (lambda (f)

1811 (if (file-exists-p (concat file f))

1812 (throw 'dirindex

1813 (setq file (concat file f))))))

1814 (yahtml-get-directory-index))

1815 nil)

1816 (setq file (concat file yahtml-directory-index))))

1817 (if (string-match "^/" file)

1818 (setq file (yahtml-url-to-path file)))

1819 (if other (YaTeX-switch-to-buffer-other-window file)

1820 (YaTeX-switch-to-buffer file))

1821 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))

1822 (if name

1823 (progn (set-mark-command nil) (yahtml-jump-to-name name)))

1824 t)))))

1825

1826 (defun yahtml-jump-to-name (name)

1827 "Jump to html's named tag."

1828 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1829 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1830 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1831 (message "Named tag `%s' not found" (substring href 1))))

1832

1833 (defun yahtml-on-begend-p (&optional p)

1834 "Check if point is on begend clause."

1835 (let ((p (or p (point))) cmd (case-fold-search t))

1836 (save-excursion

1837 (goto-char p)

1838 (if (equal (char-after (point)) ?<) (forward-char 1))

1839 (if (and (re-search-backward "<" nil t)

1840 (looking-at

1841 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1842 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1843 (condition-case nil

1844 (forward-list 1)

1845 (error nil))

1846 (< p (point)))

1847 (YaTeX-match-string 1)))))

1848

1849 (defun yahtml-goto-corresponding-begend (&optional noerr)

1850 "Go to corresponding opening/closing tag.

1851 Optional argument NOERR causes no error for unballanced tag."

1852 (let ((cmd (yahtml-on-begend-p)) m0

1853 (p (point)) (case-fold-search t) func str (nest 0))

1854 (cond

1855 (cmd

1856 (setq m0 (match-beginning 0))

1857 (if (= (aref cmd 0) ?/) ;on </cmd> line

1858 (setq cmd (substring cmd 1)

1859 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1860 func 're-search-backward)

1861 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1862 func 're-search-forward))

1863 (while (and (>= nest 0) (funcall func str nil t))

1864 (if (equal m0 (match-beginning 0))

1865 nil

1866 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1867 (if (< nest 0)

1868 (goto-char (match-beginning 0))

1869 (funcall

1870 (if noerr 'message 'error)

1871 "Corresponding tag of `%s' not found." cmd)

1872 (goto-char p)

1873 nil))

1874 (t nil))))

1875

1876 (defun yahtml-current-tag ()

1877 "Return the current tag name including #exec and #include."

1878 (save-excursion

1879 (let ((p (point)) b tag)

1880 (or (bobp)

1881 (looking-at "<")

1882 (progn (skip-chars-backward "^<") (forward-char -1)))

1883 (setq b (point))

1884 (skip-chars-forward "<")

1885 (setq tag (YaTeX-buffer-substring

1886 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1887 (goto-char b)

1888 (forward-list 1)

1889 (and (< p (point)) tag))))

1890

1891 (defun yahtml-get-attrvalue (attr)

1892 "Extract current tag's attribute value from buffer."

1893 (let (e (case-fold-search t))

1894 (save-excursion

1895 (or (looking-at "<")

1896 (progn (skip-chars-backward "^<") (backward-char 1)))

1897 (setq e (save-excursion (forward-list 1) (point)))

1898 (if (and

1899 (re-search-forward (concat "\\b" attr "\\b") e t)

1900 (progn (skip-chars-forward " \t\n=")

1901 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1902 (YaTeX-match-string 1)))))

1903

1904 (defun yahtml-goto-corresponding-img ()

1905 "View image on point"

1906 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1907 (if (and tag

1908 (string-match "img" tag)

1909 (setq image

1910 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1911 (progn

1912 (message "Invoking %s %s..." yahtml-image-viewer image)

1913 (start-process

1914 "Viewer" " * Image Viewer *"

1915 shell-file-name yahtml-shell-command-option ;"-c"

1916 (concat yahtml-image-viewer " " image))

1917 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1918

1919 (defun yahtml-goto-corresponding-source (&optional other)

1920 "Goto applet's or script's source."

1921 (let ((env (yahtml-current-tag)) s (p (point)))

1922 (cond

1923 ((string-match "applet" env)

1924 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1925 (progn

1926 (setq s (YaTeX-match-string 1)

1927 s (concat

1928 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1929 ".java"))

1930 (if other (YaTeX-switch-to-buffer-other-window s)

1931 (YaTeX-switch-to-buffer s))

1932 s) ;return source file name

1933 (message "No applet source specified")

1934 (sit-for 1)

1935 nil))

1936 ((string-match "script" env)

1937 (if (setq s (yahtml-get-attrvalue "src"))

1938 (progn

1939 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1940 'YaTeX-switch-to-buffer)

1941 (yahtml-url-to-path s))

1942 s)))

1943 ((string-match "!--#include" env)

1944 (cond

1945 ((setq s (yahtml-get-attrvalue "file")) ;

1946 (if other (YaTeX-switch-to-buffer-other-window s)

1947 (YaTeX-switch-to-buffer s))

1948 s)

1949 ((setq s (yahtml-get-attrvalue "virtual"));

1950 (setq s (yahtml-url-to-path s))

1951 (if other (YaTeX-switch-to-buffer-other-window s)

1952 (YaTeX-switch-to-buffer s))

1953 s)))

1954 ((and (string-match "!--#exec" env)

1955 (setq s (yahtml-get-attrvalue "cmd")))

1956 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1957 (let ((b " *yahtmltmp*")) ;peek a little

1958 (unwind-protect

1959 (progn

1960 (set-buffer (get-buffer-create b))

1961 (YaTeX-insert-file-contents s nil 0 100)

1962 (if (looking-at "#!")

1963 (if other (YaTeX-switch-to-buffer-other-window s)

1964 (YaTeX-switch-to-buffer s))))

1965 (kill-buffer (get-buffer b)))

1966 (get-file-buffer s))))))

1967

1968 (defun yahtml-goto-corresponding-* (&optional other)

1969 "Go to corresponding object."

1970 (interactive "P")

1971 (cond

1972 ((yahtml-goto-corresponding-href other))

1973 ((yahtml-goto-corresponding-img))

1974 ((yahtml-goto-corresponding-source other))

1975 ((yahtml-goto-corresponding-begend))

1976 (t (message "I don't know where to go."))))

1977

1978 (defun yahtml-goto-corresponding-*-other-window ()

1979 "Go to corresponding object."

1980 (interactive)

1981 (yahtml-goto-corresponding-* t))

1982

1983 (defun yahtml-visit-main ()

1984 "Go to parent file from where you visit current file."

1985 (interactive)

1986 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1987

1988 ;;; ---------- killing ----------

1989 (defun yahtml-kill-begend (&optional whole)

1990 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1991 (if tag

1992 (save-excursion

1993 (or (looking-at "<")

1994 (progn (skip-chars-backward "^<") (forward-char -1)))

1995 (setq p (point))

1996 (yahtml-goto-corresponding-begend)

1997 (or (looking-at "<")

1998 (progn (skip-chars-backward "^<") (forward-char -1)))

1999 (if (< (point) p) ;if on the opening tag

2000 (progn (setq q p p (point))

2001 (goto-char q))

2002 (setq q (point))) ;now q has end-line's (point)

2003 (if (not whole)

2004 (kill-region

2005 (progn (skip-chars-backward " \t")

2006 (if (setq bbolp (bolp)) (point) q))

2007 (progn (forward-list 1)

2008 (setq r (point))

2009 (skip-chars-forward " \t")

2010 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2011 (goto-char p)

2012 (skip-chars-backward " \t")

2013 (if (not whole)

2014 (progn

2015 (kill-append

2016 (buffer-substring

2017 (setq p (if (setq bbolp (bolp)) (point) p))

2018 (setq q (progn

2019 (forward-list 1)

2020 (setq r (point))

2021 (skip-chars-forward " \t")

2022 (if (and bbolp (eolp) (not (eobp)))

2023 (1+ (point))

2024 r))))

2025 t)

2026 (delete-region p q))

2027 (kill-region

2028 (if (bolp) (point) p)

2029 (progn (goto-char q)

2030 (forward-list 1)

2031 (setq r (point))

2032 (skip-chars-forward " \t")

2033 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2034 tag))))

2035

2036 (defun yahtml-kill-* (whole)

2037 "Kill current position's HTML tag (set)."

2038 (interactive "P")

2039 (cond

2040 ((yahtml-kill-begend whole))))

2041

2042

2043 ;;; ---------- changing ----------

2044 (defun yahtml-on-assignment-p ()

2045 "Return if current point is on parameter assignment.

2046 If so, return parameter name, otherwise nil.

2047 This function should be able to treat white spaces in value, but not yet."

2048 (let ((p (point)))

2049 (save-excursion

2050 (put 'yahtml-on-assignment-p 'region nil)

2051 (skip-chars-backward "^ \t\n")

2052 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2053 (< p (match-end 0))

2054 (>= p (1- (match-beginning 2)))

2055 (put 'yahtml-on-assignment-p 'region

2056 (cons (match-beginning 2) (match-end 2)))

2057 (YaTeX-match-string 1)))))

2058

2059 (defun yahtml-change-begend ()

2060 (let ((tag (yahtml-on-begend-p))

2061 (completion-ignore-case t)

2062 (case-fold-search t)

2063 (p (point)) (q (make-marker))

2064 (default (append yahtml-env-table yahtml-typeface-table))

2065 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2066 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2067 href b1 e1 attr new css)

2068 (cond

2069 (tag

2070 (cond

2071 ((and (string-match "^a$" tag)

2072 (save-excursion

2073 (and

2074 (re-search-backward "<a\\b" nil t)

2075 (progn

2076 (goto-char (match-end 0))

2077 (skip-chars-forward " \t\n")

2078 (setq b1 (point))

2079 (search-forward ">" nil t))

2080 (setq e1 (match-beginning 0))

2081 (goto-char b1)

2082 (re-search-forward "href\\s *=" e1 t)

2083 (>= p (point))

2084 (progn

2085 (goto-char (match-end 0))

2086 (skip-chars-forward " \t\n")

2087 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2088 (< p (match-end 0)))))

2089 (setq b1 (match-beginning 1) e1 (match-end 1)

2090 yahtml-completing-buffer (current-buffer)

2091 ;; yahtml-urls-local is buffer-local, so we must put

2092 ;; that into yahtml-urls here

2093 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2094 href (read-from-minibuffer

2095 "Change href to: " "" yahtml-url-completion-map))

2096 (if (string< "" href)

2097 (progn

2098 ;;(setq href ;??

2099 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2100 (delete-region b1 e1)

2101 (goto-char b1)

2102 (insert href))))

2103 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2104 (if (and (equal attr "class") ;treat "class" attribute specially

2105 (setq css (yahtml-css-get-element-completion-alist tag)))

2106

2107 (setq new (yahtml-read-css css))

2108 ;;other than "class", read parameter normally

2109 (setq new (yahtml-read-parameter attr)))

2110 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2111 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2112 (insert new))

2113 (t

2114 (save-excursion

2115 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2116 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2117 (skip-chars-forward "^A-Za-z")

2118 (set-marker q (point))

2119 (setq p (point))

2120 (yahtml-goto-corresponding-begend)

2121 (or (= (char-after (point)) ?<)

2122 (skip-chars-backward "^<"))

2123 (skip-chars-forward "^A-Za-z")

2124 (if (= (char-after (1- (point))) ?/)

2125 (progn

2126 (set-marker q (point))

2127 (goto-char p)))

2128 (setq tag (let ((completion-ignore-case t))

2129 (YaTeX-cplread-with-learning

2130 (format "Change `%s' to(default %s): "

2131 tag yahtml-last-begend)

2132 'default 'user 'tmp)))

2133 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2134 (if (string= "" tag) (setq tag yahtml-last-begend))

2135 (setq yahtml-last-begend

2136 (or (cdr (assoc tag yahtml-env-table)) tag)

2137 tag yahtml-last-begend)

2138 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2139 (insert (format "%s%s" tag (yahtml-addin tag)))

2140 (goto-char q)

2141 (set-marker q nil)

2142 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2143 (insert tag))))

2144 t))))

2145

2146 (defun yahtml-change-command ()

2147 (let ((p (point)) (case-fold-search t) cmd par new

2148 (beg (make-marker)) (end (make-marker)))

2149 (skip-chars-backward "^<")

2150 (if (and

2151 (looking-at yahtml-command-regexp)

2152 (progn

2153 (set-marker beg (match-beginning 0))

2154 (set-marker end (match-end 0))

2155 t) ;for further work

2156 (progn

2157 (forward-char -1)

2158 (condition-case nil

2159 (forward-list 1)

2160 (error nil))

2161 (< p (point))))

2162 (progn

2163 (goto-char p)

2164 (if (setq par (yahtml-on-assignment-p))

2165 (progn

2166 (setq new (yahtml-read-parameter par))

2167 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2168 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2169 (setq new

2170 (YaTeX-cplread-with-learning

2171 "Change form to: "

2172 'yahtml-form-table 'yahtml-user-form-table

2173 'yahtml-tmp-form-table)))

2174 (delete-region beg end)

2175 (goto-char beg)

2176 (set-marker beg nil)

2177 (set-marker end nil)

2178 (insert new)

2179 t)

2180 (goto-char p)

2181 nil)))

2182

2183 (defun yahtml-change-* ()

2184 "Change current position's HTML tag (set)."

2185 (interactive)

2186 (cond

2187 ((yahtml-change-begend))

2188 ((yahtml-change-command))))

2189

2190 ;;; ---------- commenting ----------

2191

2192 (defun yahtml-comment-region (&optional uncom)

2193 "Comment out region or environment."

2194 (interactive)

2195 (let ((e (make-marker)) be beg p)

2196 (cond

2197 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2198 (setq be (yahtml-on-begend-p))

2199 (save-excursion

2200 (setq p (point))

2201 (if (string-match "^/" be)

2202 (setq beg (progn (forward-line 1) (point)))

2203 (setq beg (progn (beginning-of-line) (point))))

2204 (goto-char p)

2205 (yahtml-goto-corresponding-begend)

2206 (if (string-match "^/" be)

2207 (beginning-of-line)

2208 (forward-line 1))

2209 (set-marker e (point))

2210 ;(comment-region beg (point) (if uncom (list 4)))))

2211 ))

2212 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2213 (setq beg (region-beginning))

2214 (set-marker e (region-end))))

2215 (if yahtml-translate-hyphens-when-comment-region

2216 (let ((yahtml-entity-reference-chars-alist-default nil)

2217 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2218 yahtml-entity-reference-chars-regexp

2219 yahtml-entity-reference-chars-reverse-regexp)

2220 (yahtml-entity-reference-chars-setup)

2221 (funcall

2222 (if uncom 'yahtml-translate-reverse-region

2223 'yahtml-translate-region)

2224 beg e)))

2225 (comment-region beg e (if uncom (list 4)))

2226 (set-marker e nil)))

2227

2228 (defun yahtml-uncomment-region ()

2229 (interactive)

2230 (yahtml-comment-region t))

2231

2232 ;;; ---------- translate to entity references ----------

2233 (defvar yahtml-entity-reference-chars-alist-default

2234 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2235 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2236 "Default translation table from character to entity reference")

2237 (defvar yahtml-entity-reference-chars-alist nil

2238 "*Translation table from character to entity reference")

2239 (defvar yahtml-entity-reference-chars-regexp nil)

2240 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2241

2242 (defun yahtml-entity-reference-chars-setup ()

2243 (let ((list (append yahtml-entity-reference-chars-alist-default

2244 yahtml-entity-reference-chars-alist)))

2245 (setq yahtml-entity-reference-chars-regexp "["

2246 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2247 (while list

2248 (setq yahtml-entity-reference-chars-regexp

2249 (concat yahtml-entity-reference-chars-regexp

2250 (char-to-string (car (car list))))

2251 yahtml-entity-reference-chars-reverse-regexp

2252 (concat yahtml-entity-reference-chars-reverse-regexp

2253 (cdr (car list))

2254 (if (cdr list) "\\|")))

2255 (setq list (cdr list)))

2256 (setq yahtml-entity-reference-chars-regexp

2257 (concat yahtml-entity-reference-chars-regexp "]")

2258 yahtml-entity-reference-chars-reverse-regexp

2259 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2260

2261 (yahtml-entity-reference-chars-setup)

2262

2263 (defun yahtml-translate-region (beg end)

2264 "Translate inhibited literals."

2265 (interactive "r")

2266 (save-excursion

2267 (save-restriction

2268 (narrow-to-region beg end)

2269 (let ((ct (append yahtml-entity-reference-chars-alist

2270 yahtml-entity-reference-chars-alist-default)))

2271 (goto-char beg)

2272 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2273 ;(setq c (preceding-char))

2274 (replace-match

2275 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2276

2277 (defun yahtml-translate-reverse-region (beg end)

2278 "Translate entity references to literals."

2279 (interactive "r")

2280 (save-excursion

2281 (save-restriction

2282 (narrow-to-region beg end)

2283 (let ((ct (append yahtml-entity-reference-chars-alist

2284 yahtml-entity-reference-chars-alist-default))

2285 ec)

2286 (goto-char beg)

2287 (while (re-search-forward

2288 yahtml-entity-reference-chars-reverse-regexp nil t)

2289 ;(setq c (preceding-char))

2290 (setq ec (YaTeX-match-string 1))

2291 (delete-region (match-end 0) (match-beginning 0))

2292 (insert (car (YaTeX-rassoc ec ct))))))))

2293

2294 (defun yahtml-inner-environment-but (exclude &optional quick)

2295 "Return the inner environment but matches with EXCLUDE tag."

2296 (let (e (case-fold-search t))

2297 (save-excursion

2298 (while (and (setq e (YaTeX-inner-environment quick))

2299 (string-match exclude e))

2300 (goto-char (get 'YaTeX-inner-environment 'point))))

2301 e))

2302

2303 (defun yahtml-untranslate-string (str)

2304 "Untranslate entity reference."

2305 (let ((md (match-data)) (left "") (right str) b0 ch

2306 (ct (append yahtml-entity-reference-chars-alist

2307 yahtml-entity-reference-chars-alist-default))

2308 (revrex yahtml-entity-reference-chars-reverse-regexp))

2309 (unwind-protect

2310 (progn

2311 (while (string< "" right)

2312 (cond

2313 ((string-match revrex right)

2314 (setq ch (YaTeX-rassoc

2315 (substring right (match-beginning 1) (match-end 1)))

2316 b0 (substring right 0 (match-beginning 0))

2317 right (substring right (match-end 0))

2318 left (concat left

2319 (substring right 0 (match-beginning 0))

2320 (char-to-string ch))))

2321 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2322 (setq ch (substring right (match-beginning 2) (match-end 2))

2323 b0 (substring right 0 (match-beginning 0))

2324 right (substring right (match-end 0))

2325 left (concat left

2326 b0

2327 (char-to-string

2328 (if (match-beginning 1)

2329 (YaTeX-hex ch)

2330 (string-to-number ch))))))

2331 (t (setq left (concat left right)

2332 right ""))))

2333 left)

2334 (store-match-data md))))

2335

2336 ;;; ---------- table-ize region ----------

2337 (defun yahtml-td-region (e delim beg end)

2338 "Enclose each item in a region with <td>..</td>.

2339 Interactive prefix argument consults enclosing element other than td."

2340 (interactive "P\nsDelimiter(s): \nr")

2341 (let ((e (if (and e (listp e)) (read-string "Enclose with : " "td") "td"))

2342 p q)

2343 (if (string= delim "") (setq delim " \t\n"))

2344 (setq delim (concat "[" delim "]+"))

2345 (save-excursion

2346 (save-restriction

2347 (narrow-to-region beg end)

2348 (goto-char (setq p (point-min)))

2349 (while (re-search-forward delim nil t)

2350 (goto-char (match-beginning 0))

2351 (insert "</" e ">")

2352 (save-excursion

2353 (goto-char p)

2354 (insert "<" e ">"))

2355 (setq p (point))

2356 (while (and (not (eobp)) (looking-at delim))

2357 (delete-char 1)))

2358 (insert "<" e ">")

2359 (goto-char (point-max))

2360 (insert "</" e ">")))))

2361

2362 (defun yahtml-tr-region (e delim beg end)

2363 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2364 (interactive "P\nsDelimiter(s): \nr")

2365 (let ((e (if (and e (listp e)) (read-string "Enclose with : " "td") "td"))

2366 p q)

2367 (if (string= delim "") (setq delim " \t\n"))

2368 ;; (setq delim (concat "[" delim "]+")) ;unnecessary here

2369 (save-excursion

2370 (save-restriction

2371 (narrow-to-region (point) (mark))

2372 (goto-char (point-min))

2373 (while (not (eobp))

2374 (insert "<tr>")

2375 (yahtml-td-region e delim (point) (point-end-of-line))

2376 (end-of-line)

2377 (insert "</tr>")

2378 (forward-line 1))))))

2379

2380 ;;; ---------- filling ----------

2381 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2382 (defun yahtml-move-to-column (col &optional force)

2383 (beginning-of-line)

2384 (let ((ccol 0))

2385 (while (and (> col ccol) (not (eolp)))

2386 (if (eq (following-char) ?\<)

2387 (progn

2388 (while (and (not (eq (following-char) ?\>))

2389 (not (eolp)))

2390 (forward-char))

2391 (or (eolp) (forward-char)))

2392 (or (eolp) (forward-char))

2393 (if (eq (preceding-char) ?\t)

2394 (let ((wd (- 8 (% (+ ccol 8) 8))))

2395 (if (and force (< col (+ ccol wd)))

2396 (progn

2397 (backward-char 1)

2398 (insert-char ?\ (- col ccol))

2399 (setq ccol col))

2400 (setq ccol (+ ccol wd))))

2401 (setq ccol (1+ ccol)))

2402 (if (and YaTeX-japan

2403 (or

2404 (and (fboundp 'char-category)

2405 (string-match "[chj]" (char-category (preceding-char))))

2406 (and (fboundp 'char-charset)

2407 (not (eq (char-charset (preceding-char)) 'ascii)))))

2408 (setq ccol (1+ ccol)))))

2409 (if (and force (> col ccol))

2410 (progn

2411 (insert-char ?\ (- col ccol))

2412 col)

2413 ccol)))

2414

2415 (defun yahtml-fill-paragraph (arg)

2416 (interactive "P")

2417 (let*((case-fold-search t) (p (point)) fill-prefix

2418 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2419 indent

2420 (startp (get 'YaTeX-inner-environment 'point))

2421 (prep (string-match "^pre$" e))

2422 (ps1 (if prep (default-value 'paragraph-start)

2423 paragraph-start))

2424 (ps2 (if prep (concat (default-value 'paragraph-start)

2425 "$\\|^\\s *</?pre>")

2426 paragraph-start)))

2427 (save-excursion

2428 (unwind-protect

2429 (progn

2430 (if prep

2431 (fset 'move-to-column 'yahtml-move-to-column))

2432 (save-excursion

2433 (beginning-of-line)

2434 (indent-to-column (yahtml-this-indent))

2435 (setq fill-prefix

2436 (buffer-substring (point) (point-beginning-of-line)))

2437 (delete-region (point) (point-beginning-of-line)))

2438 (fill-region-as-paragraph

2439 (progn (re-search-backward paragraph-start nil t)

2440 (or (save-excursion

2441 (goto-char (match-beginning 0))

2442 (if (looking-at "<")

2443 (forward-list)

2444 (goto-char (match-end 0))

2445 (skip-chars-forward " \t>"))

2446 (if (looking-at "[ \t]*$")

2447 (progn (forward-line 1) (point))))

2448 (point)))

2449 (progn (goto-char p)

2450 (re-search-forward ps2 nil t)

2451 (match-beginning 0))))

2452 (fset 'move-to-column yahtml-saved-move-to-column)))))

2453

2454 ;(defun yahtml-indent-new-commnet-line ()

2455 ; (unwind-protect

2456 ; (progn

2457 ; (fset 'move-to-column 'yahtml-move-to-column)

2458 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2459 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2460

2461 ;;;

2462 ;;; ---------- indentation ----------

2463 ;;;

2464 (defun yahtml-indent-line ()

2465 "Indent a line (faster wrapper)"

2466 (interactive)

2467 (let (indent)

2468 (if (and (save-excursion

2469 (beginning-of-line) (skip-chars-forward "\t ")

2470 (not (looking-at "<")))

2471 (save-excursion

2472 (forward-line -1)

2473 (while (and (not (bobp)) (looking-at "^\\s *$"))

2474 (forward-line -1))

2475 (skip-chars-forward "\t ")

2476 (setq indent (current-column))

2477 (not (looking-at "<"))))

2478 (progn

2479 (save-excursion

2480 (beginning-of-line)

2481 (skip-chars-forward " \t")

2482 (or (= (current-column) indent)

2483 (YaTeX-reindent indent)))

2484 (and (bolp) (skip-chars-forward " \t")))

2485 (yahtml-indent-line-real))))

2486

2487 (defun yahtml-this-indent ()

2489 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2490 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2491 (excludes

2492 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2493 inenv p col peol (case-fold-search t))

2494 (save-excursion

2495 (beginning-of-line)

2496 (setq inenv (or (yahtml-inner-environment-but excludes t)

2497 "html")

2498 col (get 'YaTeX-inner-environment 'indent)

2499 p (get 'YaTeX-inner-environment 'point)

2500 op nil))

2501 (save-excursion

2502 (cond

2503 ((string-match (concat "^\$" envs "\$") inenv)

2504 (save-excursion

2505 (beginning-of-line)

2506 (skip-chars-forward " \t")

2507 (cond ;lookup current line's tag

2508 ((looking-at (concat "</\$" envs "\$>"))

2509 col)

2510 ((looking-at itms)

2511 (+ col yahtml-environment-indent))

2512 ((and yahtml-hate-too-deep-indentation

2513 (looking-at (concat "<\$" envs "\$")))

2514 (+ col (* 2 yahtml-environment-indent)))

2515 ((and (< p (point))

2516 (string-match itemizing-envs inenv)

2517 (save-excursion

2518 (and

2519 (setq op (point))

2520 (goto-char p)

2521 (re-search-forward itms op t)

2522 (progn

2523 (if yahtml-indent-listing-constant

2524 (setq col (+ (current-column)

2525 (if yahtml-faithful-to-htmllint 1 2)))

2526 (skip-chars-forward "^>")

2527 (skip-chars-forward ">")

2528 (skip-chars-forward " \t")

2529 (setq col (if (looking-at "$")

2530 (+ col yahtml-environment-indent)

2531 (current-column))))))))

2532 col)

2533 (t

2534 (+ col yahtml-environment-indent)))))

2535 (t col)))))

2536

2537 (defun yahtml-indent-line-real ()

2538 "Indent current line."

2539 (interactive)

2540 (YaTeX-reindent (yahtml-this-indent))

2541 (if (bolp) (skip-chars-forward " \t"))

2542 (let (peol col inenv)

2543 (if (and (setq inenv (yahtml-on-begend-p))

2544 (string-match

2545 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2546 (save-excursion

2547 (setq peol (point-end-of-line))

2548 (or (= (char-after (point)) ?<)

2549 (progn (skip-chars-backward "^<") (forward-char -1)))

2550 (setq col (current-column))

2551 (if (and (yahtml-goto-corresponding-begend t)

2552 (> (point) peol)) ;if on the different line

2553 (YaTeX-reindent col))))))

2554

2555 ;(defun yahtml-fill-item ()

2556 ; "Fill item HTML version"

2557 ; (interactive)

2558 ; (let (inenv p fill-prefix peol (case-fold-search t))

2559 ; (setq inenv (or (YaTeX-inner-environment) "html")

2560 ; p (get 'YaTeX-inner-environment 'point))

2561 ; (cond

2562 ; ((string-match "^[uod]l" inenv)

2563 ; (save-excursion

2564 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2565 ; (progn

2566 ; (goto-char (match-end 0))

2567 ; (setq col (current-column)))

2568 ; (error "No <li>, <dt>, <dd>")))

2569 ; (save-excursion

2570 ; (end-of-line)

2571 ; (setq peol (point))

2572 ; (newline)

2573 ; (indent-to-column col)

2574 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2575 ; (delete-region (point) peol)

2576 ; (fill-region-as-paragraph

2577 ; (progn (re-search-backward paragraph-start nil t) (point))

2578 ; (progn (re-search-forward paragraph-start nil t 2)

2579 ; (match-beginning 0)))))

2580 ; (t nil))))

2581

2582 ;;;

2583 ;;; ---------- Lint and Browsing ----------

2584 ;;;

2585 (defun yahtml-browse-menu ()

2586 "Browsing or other external process invokation menu."

2587 (interactive)

2588 (message "J)weblint p)Browse R)eload N)ewpage...")

2589 (let ((c (char-to-string (read-char))))

2590 (cond

2591 ((string-match "j" c)

2592 (yahtml-lint-buffer (current-buffer)))

2593 ((string-match "[bp]" c)

2594 (yahtml-browse-current-file))

2595 ((string-match "r" c)

2596 (yahtml-browse-reload))

2597 ((string-match "n" c)

2598 (call-interactively 'yahtml-newpage)))))

2599

2600 (if (fboundp 'wrap-function-to-control-ime)

2601 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2602

2603 (defvar yahtml-lint-buffer "*weblint*")

2604

2605 (defun yahtml-lint-buffer (buf)

2606 "Call lint on buffer BUF."

2607 (require 'yatexprc)

2608 (interactive "bCall lint on buffer: ")

2609 (setq buf (get-buffer buf))

2610 (YaTeX-save-buffers)

2611 (let ((bcmd (YaTeX-get-builtin "lint")))

2612 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2613 (YaTeX-typeset

2614 (concat (or bcmd yahtml-lint-program)

2615 " " (file-name-nondirectory (buffer-file-name buf)))

2616 yahtml-lint-buffer "lint" "lint")))

2617

2618 (defun yahtml-file-to-url (file)

2619 "Convert local unix file name to URL.

2620 If no matches found in yahtml-path-url-alist, return raw file name."

2621 (let ((list yahtml-path-url-alist) p url)

2622 (if (file-directory-p file)

2623 (setq file (expand-file-name yahtml-directory-index file))

2624 (setq file (expand-file-name file)))

2625 (if (string-match "^[A-Za-z]:/" file)

2626 (progn

2627 ;; (aset file 1 ?|) ;これは要らないらしい…

2628 (setq file (concat "///" file))))

2629 (while list

2630 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2631 (setq url (cdr (car list))

2632 file (substring file (match-end 0))

2633 url (concat url file)

2634 list nil))

2635 (setq list (cdr list)))

2636 (or url (concat "file:" file))))

2637

2638 (defun yahtml-url-to-path (file &optional basedir)

2639 "Convert local URL name to unix file name."

2640 (let ((list yahtml-path-url-alist) url realpath docroot

2641 (dirsufp (string-match "/$" file)))

2642 (setq basedir (or basedir

2643 (file-name-directory

2644 (expand-file-name default-directory))))

2645 (cond

2646 ((string-match "^/" file)

2647 (while list

2648 (if (file-directory-p (car (car list)))

2649 (progn

2650 (setq url (cdr (car list)))

2651 (if (string-match "\$http://[^/]*\$/" url)

2652 (setq docroot (substring url (match-end 1)))

2653 (setq docroot url))

2654 (cond

2655 ((string-match (concat "^" (regexp-quote docroot)) file)

2656 (setq realpath

2657 (expand-file-name

2658 (substring

2659 file

2660 (if (= (aref file (1- (match-end 0))) ?/)

2661 (match-end 0) ; "/foo"

2662 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2663 (car (car list))))))

2664 (if realpath

2665 (progn (setq list nil)

2666 (if (and dirsufp (not (string-match "/$" realpath)))

2667 (setq realpath (concat realpath "/")))))))

2668 (setq list (cdr list)))

2669 realpath)

2670 (t file))))

2671

2672 (defun yahtml-browse-current-file ()

2673 "Call WWW browser on current file."

2674 (interactive)

2675 (basic-save-buffer)

2676 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2677

2678 (defun yahtml-browse-reload ()

2679 "Send `reload' event to netscape."

2680 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2681 (cond

2682 ((string-match "[Nn]etscape" yahtml-www-browser)

2683 (if (get-buffer pb)

2684 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2685 ;;(or (get 'yahtml-netscape-sentinel 'url)

2686 ;; (error "Reload should be called after Browsing."))

2687 (put 'yahtml-netscape-sentinel 'url

2688 (yahtml-file-to-url (buffer-file-name)))

2689 (basic-save-buffer)

2690 (set-process-sentinel

2691 (setq yahtml-browser-process

2692 (start-process

2693 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2694 (format "%s -remote 'reload'" yahtml-www-browser)))

2695 'yahtml-netscape-sentinel))

2696 (t

2697 (message "Sorry, RELOAD is supported only for Netscape.")))))

2698

2699 ;;; ---------- Intelligent newline ----------

2700 (defun yahtml-intelligent-newline (arg)

2701 "Intelligent newline for HTML"

2702 (interactive "P")

2703 (let (env func)

2704 (end-of-line)

2705 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2706 "html")))

2707 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2708 (newline)

2709 (if (and env func (fboundp func))

2710 ;; if intelligent line function is defined, call that

2711 (funcall func)

2712 ;; else do the default action

2713 (if (string-match yahtml-p-prefered-env-regexp env)

2714 (yahtml-insert-p)))))

2715

2716 (defun yahtml-intelligent-newline-ul ()

2717 (interactive)

2718 (yahtml-insert-single "li")

2719 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2720 (yahtml-indent-line))

2721

2722 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2723

2724 (defun yahtml-intelligent-newline-dl ()

2725 (interactive)

2726 (let ((case-fold-search t))

2727 (if (save-excursion

2728 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2729 (get 'YaTeX-inner-environment 'point) t))

2730 (cond

2731 ((match-beginning 2)

2732 (yahtml-insert-single "dd")

2733 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2734 (setq yahtml-last-single-cmd "dt"))

2735 ((match-beginning 3)

2736 (yahtml-insert-single "dt")

2737 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2738 (setq yahtml-last-single-cmd "dd")))

2739 (yahtml-insert-single "dt")

2740 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2741 (setq yahtml-last-single-cmd "dd"))

2742 (yahtml-indent-line)

2743 (and (string-match yahtml-p-prefered-env-regexp "dl")

2744 (string-equal yahtml-last-single-cmd "dt")

2745 (yahtml-insert-p nil))))

2746

2747 (defun yahtml-intelligent-newline-select ()

2748 (interactive)

2749 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2750 (yahtml-indent-line))

2751

2752 (defun yahtml-intelligent-newline-style ()

2753 (interactive)

2754 (if (save-excursion

2755 (and

2756 (re-search-backward "<style\\|<!-- " nil t)

2757 (looking-at "<style")))

2758 (let (c)

2759 (yahtml-indent-line)

2760 (setq c (current-column))

2761 (insert "<!--\n")

2762 (YaTeX-reindent c)

2763 (insert "-->")

2764 (beginning-of-line)

2765 (open-line 1)

2766 (YaTeX-reindent c))))

2767

2768 (defun yahtml-intelligent-newline-head ()

2769 (let ((title (read-string "Document title: "))

2770 (b "<title>") (e "</title>") p)

2771 (yahtml-indent-line)

2772 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2773 (setq p (point))

2774 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2775 (if (string= "" title) (goto-char p))

2776 (setq yahtml-last-begend "body")))

2777

2778 (defun yahtml-intelligent-newline-script ()

2779 (let ((p (point)) b)

2780 (if (save-excursion

2781 (and

2782 (setq b (re-search-backward "<script\\>" nil t))

2783 (re-search-forward

2784 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2785 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2786 c (srcp (re-search-backward "src=" b t)))

2787 (goto-char p)

2788 (yahtml-indent-line)

2789 (setq c (current-column))

2790 (if srcp

2791 nil

2792 (insert "")

2793 (beginning-of-line)

2794 (open-line 1)

2795 (YaTeX-reindent c))))))

2796

2797 (defun yahtml-intelligent-newline-table ()

2798 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2799 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2800 (cond

2801 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2802 (while (and (setq rb (re-search-backward ptn tb t))

2803 (match-beginning 1))

2804 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2805 (goto-char (match-end 0))

2806 (skip-chars-forward " \t\n")

2807 (if (and (search-forward "colspan\\s *=" p t)

2808 (progn

2809 (skip-chars-forward "\"' \t\n")

2810 (looking-at "[0-9]+")))

2811 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2812 (setq cols (1+ cols)))

2813 (goto-char rb)

2814 (setq p (point)))

2815 (if (> cols 0)

2816 (message "%s columns found. %s"

2817 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2818 "New tr?(N) or Duplicate")))

2819 (cond

2820 ((and (> cols 0)

2821 (memq (read-char) '(?d ?D))) ;Duplication mode

2822 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2823 (t ;empty cells

2824 (setq line "<tr>" i 0)

2825 (if (> cols 0)

2826 (while (> cols i)

2827 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2828 "<td></td>"))

2829 th nil i (1+ i)))

2830 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2831 (while (string-match "t\$h\$\\|td" fmt i)

2832 (setq line (concat line (if (match-beginning 1) "<th></th>"

2833 "<td></td>"))

2834 i (match-end 0))))

2835 (setq line (concat line "</tr>"))))

2836 (goto-char cp)

2837 (if th

2838 (message

2839 "Type `%s' to change td from/to th."

2840 (key-description (car (where-is-internal 'yahtml-change-*)))))

2841 (if (string< "" line)

2842 (progn

2843 (insert line)

2844 (goto-char (+ 8 cp))

2845 (yahtml-indent-line)))))))

2846

2847 ;;; ---------- Marking ----------

2848 (defun yahtml-mark-begend ()

2849 "Mark current tag"

2850 (interactive)

2851 (YaTeX-beginning-of-environment)

2852 (let ((p (point)))

2853 (save-excursion

2854 (skip-chars-backward " \t" (point-beginning-of-line))

2855 (if (bolp) (setq p (point))))

2856 (push-mark p t))

2857 (yahtml-goto-corresponding-begend)

2858 (forward-list 1)

2859 (if (eolp) (forward-char 1)))

2860

2861 ;;; ---------- complete marks ----------

2862 (defun yahtml-complete-mark ()

2863 "Complete &gt, &lt, &ampersand, and &quote."

2864 (interactive)

2865 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2866 (let ((c (read-char)))

2867 (setq c (if (or (< c ?0) (> c ?7))

2868 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2869 (- c ?1)))

2870 (if (or (< c 0) (> c 6))

2871 nil

2872 (insert (format "&%s;"

2873 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2874

2875

2876 ;;; ---------- jump to error line ----------

2877 (defun yahtml-prev-error ()

2878 "Jump to previous error seeing lint buffer."

2879 (interactive)

2880 (or (get-buffer yahtml-lint-buffer)

2881 (error "No lint program ran."))

2882 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2883 (yahtml-jump-to-error-line t))

2884

2885 (defun yahtml-jump-to-error-line (&optional sit)

2886 (interactive "P")

2887 (let ((p (point)) (e (point-end-of-line)))

2888 (end-of-line)

2889 (if (re-search-backward yahtml-error-line-regexp nil t)

2890 (let ((f (if (string= "" (YaTeX-match-string 1))

2891 YaTeX-current-file-name

2892 (YaTeX-match-string 1)))

2893 (l (string-to-int (or (YaTeX-match-string 2)

2894 (YaTeX-match-string 3)))))

2895 (if sit (sit-for 1))

2896 (forward-line -1)

2897 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2898 (goto-line l))

2899 (message "No line number usage"))))

2900

2901 ;;; ---------- Style Sheet Support ----------

2902 (defvar yahtml-css-class-alist nil

2903 "Alist of elements vs. their classes")

2904

2905 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2906 (save-excursion

2907 (save-restriction

2908 (narrow-to-region beg end)

2909 (goto-char (point-min))

2910 (let ((alist initial) b e element class a)

2911 (setq b (point))

2912 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2913 (if (match-beginning 2)

2914 (let ((f (YaTeX-buffer-substring

2915 (progn (skip-chars-forward "^\"")(1+ (point)))

2916 (progn (forward-char 1)

2917 (skip-chars-forward "^\"")(point)))))

2918 (if (file-exists-p f)

2919 (setq alist

2920 (append alist (yahtml-css-collect-classes-file f)))))

2921 (setq e (point))

2922 (goto-char b)

2923 (while (re-search-forward ;ちょといい加減なREGEXP

2924 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2925 e t)

2926 (setq element (YaTeX-match-string 1)

2927 class (YaTeX-match-string 2))

2928 ;;if starts with period (match-string 1 is nil),

2929 ;;this is global class

2930 (setq element (downcase (or element "*")))

2931 (if (setq a (assoc element alist))

2932 (or (assoc class (cdr a))

2933 (setcdr a (cons (list class) (cdr a))))

2934 (setq alist (cons (list element (list class)) alist))))

2935 (goto-char (1- e))

2936 (search-forward "}" nil t)

2937 (setq b (point))))

2938 alist))))

2939

2940 (defun yahtml-css-collect-classes-buffer (&optional initial)

2941 (interactive)

2942 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2943

2944 (defun yahtml-css-collect-classes-file (file &optional initial)

2945 (let*((hilit-auto-highlight nil)

2946 (buf (get-buffer-create

2947 (format " *css-collection*%s" (file-name-nondirectory file))))

2948 (cb (current-buffer)))

2949 (unwind-protect

2950 (progn

2951 (set-buffer buf)

2952 (insert-file-contents file)

2953 (cd (or (file-name-directory file) "."))

2954 (yahtml-css-collect-classes-buffer initial))

2955 (if (eq buf cb)

2956 nil

2957 (kill-buffer buf)

2958 (set-buffer cb)))))

2959

2960 (defun yahtml-css-scan-styles ()

2961 (save-excursion

2962 (goto-char (point-min))

2963 (set (make-local-variable 'yahtml-css-class-alist) nil)

2964 (let (b tag type e href alist)

2965 (while (re-search-forward "<\$style\\|link\$" nil t)

2966 (setq b (match-beginning 0)

2967 tag (YaTeX-match-string 1))

2968 (cond

2969 ((string-match "style" tag)

2970 (goto-char b)

2971 (save-excursion (forward-list 1) (setq e (point)))

2972 (cond

2973 ((search-forward "text/css" e 1) ;css definition starts

2974 (setq alist

2975 (yahtml-css-collect-classes-region

2976 (point) (progn (search-forward "</style>") (point))

2977 alist)))))

2978 ((and (string-match "link" tag)

2979 (stringp (setq type (yahtml-get-attrvalue "type")))

2980 (string-match "text/css" type)

2981 (setq href (yahtml-get-attrvalue "href"))

2982 (file-exists-p (yahtml-url-to-path href)))

2983 (setq alist

2984 (yahtml-css-collect-classes-file

2985 (yahtml-url-to-path href) alist))))

2986 (setq yahtml-css-class-alist alist)))))

2987

2988 (defun yahtml-css-get-element-completion-alist (element)

2989 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

2990 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

2991 (and (or alist global)

2992 (append alist global))))

2993

2994 ;;; ---------- ----------

2995

2996 ;;;

2997 ;;hilit19

2998 ;;;

2999 (defvar yahtml-default-face-table

3000 '(

3001 (form black/ivory white/hex-442233 italic)

3002 ))

3003 (defvar yahtml-hilit-patterns-alist

3004 '(

3005 'case-fold

3006 ;; comments

3007 ("" comment)

3008 ;; include&exec

3009 ("" include)

3010 ;; string

3011 (hilit-string-find ?\\ string)

3012 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3013 ("</?[uod]l>" 0 decl)

3014 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3015 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3016 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3017 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3018 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3019 ))

3020

3021 (defun yahtml-hilit-region-tag (tag)

3022 "Return list of start/end point of <TAG> form."

3023 (if (re-search-forward tag nil t)

3024 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3025 (elm (YaTeX-match-string 1)))

3026 (skip-chars-forward "^>")

3027 (prog1

3028 (cons (1+ (point))

3029 (progn (re-search-forward (concat "</" elm ">") nil t)

3030 (match-beginning 0)))

3031 (goto-char e0)))))

3032

3033 (defun yahtml-hilit-region-tag-itself (ptn)

3034 "Return list of start/end point of <tag options...> itself."

3035 (if (re-search-forward ptn nil t)

3036 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3037 (skip-chars-forward "^<>")

3038 (if (eq (char-after (point)) ?<) nil

3039 (prog1

3040 (cons m0 (min (point-max) (1+ (point))))

3041 (goto-char e0))))))

3042

3043 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3044 (and yahtml-use-hilit19

3045 (or (assq 'yahtml-mode hilit-patterns-alist)

3046 (setq hilit-patterns-alist

3047 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3048 hilit-patterns-alist))))

3049 ;;;

3050 ;; for font-lock

3051 ;;;

3052

3053 ; <<STATIC KEYWORDS BELOW NOT USED>>

3054 ;(defvar yahtml-font-lock-keywords

3055 ; '(

3056 ; ;; comments

3057 ; ("" . font-lock-comment-face)

3058 ; ;; include&exec

3059 ; (""

3060 ; 0 font-lock-include-face keep)

3061 ; ;; string

3062 ; ;(hilit-string-find ?\\ string)

3063 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3064 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3065 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3066 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3067 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3068 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3069 ; )

3070 ; "*Defualt font-lock-keywords for yahtml-mode.")

3071 (defvar yahtml-font-lock-keywords

3072 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3073 "Default fontifying patterns for yahtml-mode")

3074

3075 (defun yahtml-font-lock-set-default-keywords ()

3076 (put 'yahtml-mode 'font-lock-defaults

3077 '(yahtml-font-lock-keywords nil t)))

3078

3079 (if yahtml-use-font-lock

3080 (progn

3081 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3082 ;;for those who use both hilit19 and font-lock

3083 (if (eq (car hilit-mode-enable-list) 'not)

3084 (or (member 'yahtml-mode hilit-mode-enable-list)

3085 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3086 (setq hilit-mode-enable-list

3087 (delq 'yahtml-mode hilit-mode-enable-list))))

3088 (yahtml-font-lock-set-default-keywords)))

3089

3090 (defun yahtml-font-lock-recenter (&optional arg)

3091 (interactive "P")

3092 (font-lock-mode -1) ;is stupid, but sure.

3093 (font-lock-mode 1))

3094

3095 (run-hooks 'yahtml-load-hook)

3096 (provide 'yahtml)

3097

3098 ; Local variables:

3099 ; fill-prefix: ";;; "

3100 ; paragraph-start: "^$\\|\\|;;;$"

3101 ; paragraph-separate: "^$\\|\\|;;;$"

3102 ; coding: sjis

3103 ; End: