yatex: 1c41dc8a28eb yahtml.el

yatex

view yahtml.el @ 183:1c41dc8a28eb

doc fix

author	yuuji@gentei.org
date	Thu, 13 Oct 2011 10:16:58 +0900
parents	2f183a28d798
children	af2098da767b

line source

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

3 ;;; Last modified Mon May 16 15:49:38 2011 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 ;;;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

166 ;;;

167 ;;; [謝辞]

168 ;;;

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

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

171 ;;;

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

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

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

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

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

177 ;;;

178

179

180 (require 'yatexlib)

181 ;;; --- customizable variable starts here ---

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

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

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

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

186 (defvar yahtml-kanji-code 2

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

188 ;;(defvar yahtml-coding-system

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

190 ;; "Kanji coding system")

191 (and (featurep 'mule)

192 (integerp yahtml-kanji-code)

193 (setq yahtml-kanji-code

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

195

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

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

198

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

200 (defvar yahtml-path-url-alist nil

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

202 Ex.

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

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

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

206 "*Directory index file name;

207 Consult your site's WWW administrator.")

208

209 (defvar yahtml-environment-indent 1

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

211

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

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

214 "*Program name to lint HTML file")

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

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

217

218 (defvar yahtml-always-/p t

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

220 (defvar yahtml-always-/li nil

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

222 (defvar yahtml-always-/dt nil

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

224 (defvar yahtml-always-/dd nil

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

226

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

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

229

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

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

232

233 (defvar yahtml-prefer-upcases nil

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

235

236 (defvar yahtml-prefer-upcase-attributes nil

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

238

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

240

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

242 "*Server access file name for apache")

243

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

245

246 (defvar yahtml-image-inspection-bytes 500000

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

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

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

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

251 %f: filename")

252

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

254 (defvar yahtml-error-line-regexp

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

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

257

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

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

260 (defvar yahtml-escape-chars 'ask

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

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

263 at each reserved chars.")

264

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

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

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

268

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

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

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

272

273 (defvar yahtml-mode-abbrev-table nil

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

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

276

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

278 "*Boundary regexp for indentation calculation.")

279

280 (defvar yahtml-html4-strict t

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

282 Completing read for obsoleted attributes disabled.")

283

284 ;;; --- customizable variable ends here ---

285 (defvar yahtml-prefix-map nil)

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

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

288 (defvar yahtml-shell-command-option

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

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

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

292

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

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

295 (YaTeX-define-key

296 key

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

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

299 map))

300

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

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

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

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

305

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

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

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

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

310 (if YaTeX-inhibit-prefix-letter nil

311 (yahtml-define-begend-region-key

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

313

314 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

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

327 (let ((map yahtml-prefix-map))

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

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

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

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

332 (and YaTeX-emacs-19 window-system

333 (progn

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

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

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

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

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

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

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

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

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

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

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

345 (if YaTeX-no-begend-shortcut

346 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

385 (substitute-all-key-definition

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

387 (substitute-all-key-definition

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

389

390 (if yahtml-lint-buffer-map nil

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

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

393

394

395 (defvar yahtml-paragraph-start

396 (concat

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

398 "*Regexp of html paragraph separater")

399 (defvar yahtml-paragraph-separate

400 (concat

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

402 "*Regexp of html paragraph separater")

403 (defvar yahtml-syntax-table nil

404 "*Syntax table for yahtml-mode")

405

406 (if yahtml-syntax-table nil

407 (setq yahtml-syntax-table

408 (make-syntax-table (standard-syntax-table)))

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

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

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

412

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

414 "Regexp of constituent of html commands.")

415

416 ;;; Completion tables for `form'

417 (defvar yahtml-form-table

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

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

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

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

422

423 (defvar yahtml-env-table

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

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

426 ("OrderedList" . "ol")

427 ("UnorderedList" . "ul")

428 ("DefinitionList" . "dl")

429 ("Preformatted" . "pre")

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

431 ("address") ("button")

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

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

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

435 ))

436

437 (if yahtml-html4-strict

438 (setq yahtml-env-table

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

440

441 ;(defvar yahtml-itemizing-regexp

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

443 ; "Regexp of itemizing forms")

444

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

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

447

448 ;;; Completion tables for typeface designator

449 (and yahtml-always-/p

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

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

452 (and yahtml-always-/li

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

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

455 (and yahtml-always-/dt

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

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

458 (and yahtml-always-/dd

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

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

461

462 (defvar yahtml-typeface-table

463 (append

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

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

466 ("sup") ("sub") ("span") ("abbr"))

467 (if (not yahtml-html4-strict)

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

469 yahtml-env-table)

470 "Default completion table of typeface designator")

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

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

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

474

475 (defvar yahtml-single-cmd-table

476 '(("hr") ("br") ("option")

477 ("HorizontalRule" . "hr")

478 ("BreakLine" . "br")

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

480 ("!--#exec")

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

482 ("!--#include")

483 ;; ("Item" . "li")

484 ;; ("DefineTerm" . "dt")

485 ;; ("Description" . "dd")

486 ;; ("dd") ("dt") ("li")

487 )

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

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

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

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

492

493 (defvar yahtml-current-completion-type nil

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

495

496 (defvar yahtml-struct-name-regexp

497 (concat

498 "\\<\\("

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

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

501 "\\)\\b")

502 "Regexp of structure beginning.")

503

504 (defvar yahtml-closable-regexp

505 (concat

506 "\\<\\("

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

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

509 "\\)\\b")

510 "Regexp of any closable elemnts.")

511

512 (defvar yahtml-indent-listing-constant t

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

514 T for static indentation depth")

515

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

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

518

519

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

521 (cond

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

523 buffer-file-name)

524 (let ((dir default-directory)

525 charset af ext (ldir "")

526 line

527 (case-fold-search t)

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

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

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

531 (while (and dir

532 (not (string= dir ldir))

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

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

535 (if (file-exists-p af)

536 (save-excursion

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

538 (save-excursion

539 (goto-char (point-min))

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

541 (setq line (buffer-substring

542 (point-beginning-of-line)

543 (point-end-of-line))

544 dir nil)))

545 (kill-buffer (current-buffer))))

546 (if dir

547 (setq ldir dir

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

549 dir (file-name-directory dir))))

550 line))

551 (t nil)))

552

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

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

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

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

557 (case-fold-search t)

558 line

559 charset)

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

561 (progn

562 (string-match ptn line)

563 (setq charset

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

565 (cond

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

567 (setq charset 2))

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

569 (setq charset 3))

570 ((string-match "shift_jis" charset)

571 (setq charset 1))

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

573 (setq charset 4))

574 (t (setq charset nil)))

575 (setq dir "")))

576 (if (featurep 'mule)

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

578 charset))

579

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

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

582 x index-list)

583 ;;s/\\s *$//;

584 (if line

585 (progn

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

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

588 (while (string< "" line)

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

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

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

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

593 line "")))

594 (or (nreverse index-list)

595 (if (listp yahtml-directory-index)

596 yahtml-directory-index

597 (list yahtml-directory-index)))))))

598

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

600 (defun yahtml-mode ()

601 (interactive)

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

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

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

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

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

607 (cond

608 ((null coding) nil)

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

610 (setq buffer-file-coding-system

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

612 (save-excursion

613 (goto-char (point-min))

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

615 coding)))

616 ((featurep 'mule)

617 (set-file-coding-system coding))

618 ((boundp 'NEMACS)

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

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

621 (setq major-mode 'yahtml-mode

622 mode-name "yahtml"

623 YaTeX-current-file-name (file-name-nondirectory

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

625 local-abbrev-table yahtml-mode-abbrev-table)

626 (mapcar

627 (function (lambda (x)

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

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

630 (boundp (cdr x)))

631 (symbol-value (cdr x))

632 (cdr x)))))

633 '((YaTeX-ec . "")

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

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

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

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

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

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

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

641 (paragraph-start . yahtml-paragraph-start)

642 (paragraph-separate . yahtml-paragraph-separate)

643 (comment-start . "")

644 (comment-start-skip . comment-start)

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

646

647 (if yahtml-use-font-lock

648 (progn

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

650 (or (featurep 'xemacs)

651 (progn

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

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

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

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

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

657 (font-lock-fontify-buffer)))))

658 (set-syntax-table yahtml-syntax-table)

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

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

661 (yahtml-css-scan-styles)

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

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

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

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

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

667

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

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

670 font-lock-defaults)

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

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

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

674

675 (defun yahtml-version ()

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

677 (interactive)

678 (message

679 (concat "Yet Another HTML-mode "

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

681 " Revision "

682 yahtml-revision-number)))

683

684 (defun yahtml-quit ()

685 (interactive)

686 (and yahtml-mode-old-mode

687 (fboundp yahtml-mode-old-mode)

688 (funcall yahtml-mode-old-mode)))

689

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

691 (cond

692 ((featurep 'xemacs)

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

694 (set keymap nil)

695 (mapcar

696 (function

697 (lambda (bind)

698 (setq bind (cdr bind))

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

700 (setcar (cdr bind) 'progn))

701 (if (stringp (car (cdr bind)))

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

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

704 (symbol-value keymap))))))

705 bindlist)

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

707 (t

708 (mapcar

709 (function

710 (lambda (bind)

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

712 bindlist))))

713

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

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

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

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

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

719

720 ;;; Variables for mosaic url history

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

722 (defvar yahtml-urls-private nil)

723 (defvar yahtml-urls-local nil)

724

725 (cond

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

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

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

729 (YaTeX-define-menu

730 'yahtml-menu-map-sectioning

731 (nreverse

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

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

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

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

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

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

738 )))

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

740 (YaTeX-define-menu

741 'yahtml-menu-map-logical

742 (nreverse

743 '((em "Embolden" .

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

745 (dfn "Define a word" .

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

747 (cite "Citation" .

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

749 (code "Code" .

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

751 (kbd "Keyboard" .

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

753 (samp "Sample display" .

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

755 (strong "Strong" .

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

757 (VAR "Variable notation" .

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

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

760 (YaTeX-define-menu

761 'yahtml-menu-map-typeface

762 (nreverse

763 '((b "Bold" .

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

765 (i "Italic" .

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

767 (tt "Typewriter" .

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

769 (u "Underlined" .

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

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

772 (YaTeX-define-menu

773 'yahtml-menu-map-listing

774 (nreverse

775 '((ul "Unordered" .

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

777 (ol "Ordered" .

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

779 (dl "Definition" .

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

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

782 (YaTeX-define-menu

783 'yahtml-menu-map-item

784 (nreverse

785 '((li "Simple item" .

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

787 (dt "Define term" .

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

789 (dd "Description of term" .

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

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

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

793 (YaTeX-define-menu

794 'yahtml-menu-map

795 (nreverse

796 (list

797 (cons (list 'sect "Sectioning")

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

799 (cons (list 'list "Listing")

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

801 (cons (list 'item "Item")

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

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

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

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

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

807 (if (featurep 'xemacs)

808 (add-hook 'yahtml-mode-hook

809 '(lambda ()

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

811 (progn

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

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

814

815 ;;; ----------- Completion ----------

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

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

818 "Insert <cmd> ... </cmd>."

819 (interactive "P")

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

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

822 (cmd

823 (or env

824 (YaTeX-cplread-with-learning

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

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

827 (bolp (save-excursion

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

829 (cc (current-column)))

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

831 (setq yahtml-last-begend

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

833 yahtml-last-begend))

834 (setq cmd yahtml-last-begend)

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

836 (if region

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

838 ;; to enable continuous regioning by another environment

839 (let ((beg (region-beginning))

840 (end (region-end))

841 (addin (yahtml-addin cmd)))

842 (save-excursion

843 (goto-char end)

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

845 (goto-char beg)

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

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

848 (save-excursion

849 (insert "\n")

850 (indent-to-column cc)

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

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

853 (newline)

854 (yahtml-intelligent-newline nil))

855 (yahtml-indent-line))))

856

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

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

859 (interactive)

860 (yahtml-insert-begend t))

861

862

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

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

865 (interactive)

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

867 (or form

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

869 (setq form

870 (YaTeX-cplread-with-learning

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

872 'yahtml-form-table 'yahtml-user-form-table

873 'yahtml-tmp-form-table))))

874 (let ((p (point)) q)

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

876 (setq yahtml-last-form form)

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

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

879 ;;(indent-relative-maybe)

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

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

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

883

884 (defun yahtml-read-css (alist)

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

886 (minibuffer-completion-table alist))

887 (read-from-minibuffer

888 (substitute-command-keys

889 (if YaTeX-japan

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

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

892 nil YaTeX-minibuffer-completion-map nil)))

893

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

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

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

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

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

899 (defun yahtml-newpage (file ov)

900 "Create newpage via newpage script"

901 (interactive

902 (list

903 (let (insert-default-directory)

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

905 current-prefix-arg))

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

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

908 (insert (substring

909 (YaTeX-command-to-string

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

911 0 -1)))

912

913 ;;; ---------- Add-in ----------

914 (defun yahtml-addin (form)

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

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

917 (concat

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

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

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

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

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

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

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

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

926 (string< "" s))

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

928 ""))))

929

930 (defvar yahtml-completing-buffer nil)

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

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

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

934 (let (list end)

935 (save-excursion

936 (set-buffer yahtml-completing-buffer)

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

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

939 (save-excursion

940 (goto-char (point-min))

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

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

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

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

945 (setq end (match-end 0))

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

947 (yahtml-on-assignment-p)

948 (progn

949 (goto-char end)

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

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

952 (setq list (cons

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

954 list))))

955 list))))

956

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

958 (if yahtml-url-completion-map nil

959 (setq yahtml-url-completion-map

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

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

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

963

964 (defun yahtml-complete-url ()

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

966 (interactive)

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

968 (lim (YaTeX-minibuffer-begin))

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

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

971 (cond

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

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

974 listfunc (list 'lambda nil

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

976 beg min))

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

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

979 (progn

980 (setq path (substring initial 0 beg))

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

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

983 (setq initial (substring initial beg))

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

985 cmpl (try-completion initial labels)

986 listfunc (list 'lambda ()

987 (list 'all-completions

988 initial (list 'quote labels)))

989 beg (+ min beg)))

990 (t

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

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

993 initial))

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

995 file (file-name-nondirectory path)

996 initial file

997 cmpl (file-name-completion file dir)

998 listfunc (list 'lambda nil

999 (list 'file-name-all-completions

1000 file dir))

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

1002 (cond

1003 ((stringp cmpl)

1004 (if (string= initial cmpl)

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

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

1007 (princ

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

1009 (delete-region (point) beg)

1010 (insert cmpl)))

1011 ((null cmpl)

1012 (ding))

1013 ((eq t cmpl)

1014 (save-excursion

1015 (unwind-protect

1016 (progn

1017 (goto-char p)

1018 (insert " [Sole completion]"))

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

1020

1021 ;

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

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

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

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

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

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

1028 ;

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

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

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

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

1033 (defvar yahtml-unsafe-chars-regexp

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

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

1036 ;

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

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

1039 ;

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

1041 ; "$" | ","

1042 (defvar yahtml-unreserved-chars-regexp

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

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

1045 Not used yet.")

1046

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

1048 "Translate reserved chars to URL encoded string."

1049 (let ((p 0) (target "")

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

1051 (cond

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

1053 (t

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

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

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

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

1058 (setq target (concat target

1059 (substring str 0 p)

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

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

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

1063 (concat target str)))))

1064

1065 (defun yahtml-unescape-string (str)

1066 "Untranslate reserved URL-encoded string."

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

1068 (unwind-protect

1069 (progn

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

1071 (setq target (concat target

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

1073 p (match-end 0)

1074 c (YaTeX-hex (substring

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

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

1077 (concat target (substring str p)))

1078 (store-match-data md))))

1079

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

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

1082 (interactive "r")

1083 (save-excursion

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

1085 (goto-char beg)

1086 (while (and (< (point) e)

1087 (re-search-forward

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

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

1090 (sit-for 0)

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

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

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

1094 ; (unwind-protect

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

1096 ; (save-excursion

1097 ; (backward-char 1)

1098 ; (delete-backward-char 4))

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

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

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

1102 (progn

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

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

1105 (set-marker e nil))))

1106 ;; ab%defgls/.|

1107

1108 (defun yahtml:a ()

1109 "Add-in function for <a>"

1110 (let ((href ""))

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

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

1113 href (yahtml-escape-chars-string

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

1115 (prog1

1116 (concat (yahtml-make-optional-argument

1117 "href" href)

1118 (yahtml-make-optional-argument

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

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

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

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

1123 (YaTeX-update-table

1124 (list href)

1125 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local)))))

1126

1127 (defvar yahtml-parameters-completion-alist

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

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

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

1131 ("src" . file) ("file" . file)

1132 ("background" . file)

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

1134 ("method" ("POST") ("GET"))

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

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

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

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

1139 ("http-equiv" ("Refresh"))))

1140

1141 (defvar yahtml-link-types-alist

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

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

1144 ("subsection") ("appendix") ("help") ("bookmark")))

1145

1146 (defvar yahtml-content-types-alist

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

1148 ("text/sgml") ("text/xml")

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

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

1151 ("application/java")

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

1153 "Alist of content-types")

1154

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

1156 (let* ((alist

1157 (cdr-safe (assoc (downcase par)

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

1159 (prompt (concat par ": "))

1160 v)

1161 (cond

1162 ((eq alist 'file)

1163 (let ((insert-default-directory))

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

1165 ((eq alist 'command)

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

1167 (read-shell-command prompt)

1168 (read-string prompt)))

1169 ((and alist (symbolp alist))

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

1171 (alist

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

1173 (t

1174 (read-string prompt default)))))

1175

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

1177 "Make optional argument string."

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

1179 ""

1180 (concat " "

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

1182 "=\"" arg "\"")))

1183

1184 (defun yahtml:html ()

1185 "Add-in for <html>"

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

1187 (yahtml-make-optional-argument

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

1189

1190 (defun yahtml:head ()

1191 "Add-in for <head>"

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

1193 "")

1194

1195 (defun yahtml:body ()

1196 "Add-in function for <body>"

1197 (cond

1198 (yahtml-html4-strict nil)

1199 (t

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

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

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

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

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

1205 (concat

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

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

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

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

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

1211

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

1213 "Make CSS property definitions in style attribute."

1214 (mapconcat

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

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

1217 (delq nil proplist)

1218 " "))

1219

1220 (defun yahtml:img ()

1221 "Add-in function for <img>"

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

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

1224 alt

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

1226 (l yahtml-prefer-upcase-attributes)

1227 info width height bytes comments)

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

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

1230 (car info)

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

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

1233 bytes (car (cdr (cdr info)))

1234 comments (nth 4 info)))

1235 (if info

1236 (setq alt

1237 (YaTeX-replace-formats

1238 yahtml:img-default-alt-format

1239 (list (cons "x" width)

1240 (cons "y" height)

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

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

1243 (cons "c" (car comments))))))

1244

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

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

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

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

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

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

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

1252 (if yahtml-html4-strict

1253 (yahtml-make-optional-argument

1254 "style"

1255 (if (or brd alg)

1256 (yahtml-make-style-parameter

1257 (list

1258 (if (string< "" alg)

1259 (cons "align" alg))

1260 (if (string< "" brd)

1261 (cons "border"

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

1263 (concat

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

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

1266

1267 (defun yahtml-file-truename (file)

1268 (cond

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

1270 (t (let ((new file))

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

1272 (not (equal new file)))

1273 (setq file new))

1274 file))))

1275

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

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

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

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

1280 (let ((mlt 1)

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

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

1283 (value 0))

1284 (while (> length 0)

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

1286 pos (+ pos direc)

1287 mlt (* mlt 256)

1288 length (1- length)))

1289 value))

1290

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

1292 "Return the information on the image file FILE.

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

1294 (save-excursion

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

1296 width height bytes depth comment

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

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

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

1300 (seekpoint 1)

1301 c1 c2 c3 c4 beg end

1302 (case-fold-search nil))

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

1304 (set-buffer tmpbuf)

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

1306 (erase-buffer)

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

1308 (unwind-protect

1309 (progn

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

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

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

1313 (YaTeX-insert-file-contents

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

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

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

1317 c2 (char-after 2)

1318 c3 (char-after 3)

1319 c4 (char-after 4))

1320 (cond

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

1322 ;;JPEG images need JPEG markers inspection

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

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

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

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

1327 (catch 'exit

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

1329 (cond

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

1331 ;maybe corrupted, exit from loop

1332 (throw 'exit t))

1333 ((memq

1334 (char-after (1+ seekpoint))

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

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

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

1338 ;;found!

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

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

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

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

1343 ;; JPEG comment area

1344 (setq beg (+ seekpoint 2 2)

1345 end (+ seekpoint

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

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

1348 (t ;other markers

1349 nil)) ;just skip it

1350 (setq seekpoint (+ seekpoint 2)

1351 seekpoint (+ seekpoint

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

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

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

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

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

1357 height (yahtml-hex-value 20 4)

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

1359 ((looking-at "GIF8")

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

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

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

1363 ((looking-at "BM")

1364 ;;# OS/2, Windoze BMP files

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

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

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

1368 (cond

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

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

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

1372 (t

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

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

1375 (message "")

1376 (kill-buffer tmpbuf))

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

1378

1379 (defun yahtml:form ()

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

1381 (concat

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

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

1384 "\""

1385 (yahtml-make-optional-argument

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

1387 (completing-read

1388 "Enctype: "

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

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

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

1392

1393 (defun yahtml:select ()

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

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

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

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

1398

1399 (defun yahtml:ol ()

1400 "Add-in function for <ol>"

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

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

1403 (type (completing-read

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

1405 (concat

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

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

1408 (defun yahtml:ul ()

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

1410 (defun yahtml:dl ()

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

1412 (defun yahtml:dt ()

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

1414

1415 (defun yahtml:p ()

1416 (if yahtml-html4-strict nil

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

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

1419

1420 (defvar yahtml-input-types

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

1422 ("reset") ("image") ("hidden") ("file")))

1423

1424 (defun yahtml:input ()

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

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

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

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

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

1430 yahtml-input-types nil t)

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

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

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

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

1435 (concat

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

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

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

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

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

1441

1442 (defun yahtml:textarea ()

1443 "Add-in function for `textarea'"

1444 (interactive)

1445 (let (name rows cols)

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

1447 cols (read-string "Columns: ")

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

1449 (concat

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

1451 "\"" name "\"")

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

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

1454

1455 (defun yahtml:table ()

1456 "Add-in function for `table'"

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

1458 (a (yahtml-read-parameter

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

1460 (if yahtml-html4-strict

1461 (yahtml-make-optional-argument

1462 "style"

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

1464 (yahtml-make-style-parameter

1465 (append

1466 (if (string< "" b)

1467 (list

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

1469 (cons "border-collapse" "collapse")))

1470 (if (string< "" a)

1471 (cond

1472 ((string-match "right" a)

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

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

1475 ((string-match "center" a)

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

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

1478 (concat

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

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

1481

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

1483 (defun yahtml:caption ()

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

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

1486 (if yahtml-html4-strict

1487 (yahtml-make-optional-argument

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

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

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

1491

1492 (defun yahtml:font ()

1493 "Add-in function for `font'"

1494 (concat

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

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

1497

1498 (defun yahtml:style ()

1499 "Add-in function for `style'"

1500 (yahtml-make-optional-argument

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

1502

1503 (defun yahtml:script ()

1504 "Add-in function for `script'"

1505 (concat

1506 (yahtml-make-optional-argument

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

1508 (yahtml-make-optional-argument

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

1510

1511 (defun yahtml:tr ()

1512 "Add-in function for `tr'"

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

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

1515 "")

1516

1517 (defun yahtml:link ()

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

1519 (let (rel rev type href)

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

1521 (cond

1522 ((equal rel "")

1523 (concat (yahtml-make-optional-argument

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

1525 (yahtml-make-optional-argument

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

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

1528 )))

1529 ((string-match "stylesheet" rel)

1530 (concat

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

1532 (yahtml-make-optional-argument

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

1534 (progn

1535 (setq href

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

1537 (if (string< "" href)

1538 (progn

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

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

1541 (setq yahtml-css-class-alist

1542 (yahtml-css-collect-classes-file

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

1544 (message "")

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

1546 (t

1547 (concat

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

1549 (yahtml-make-optional-argument

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

1551 (yahtml-make-optional-argument

1552 "href"

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

1554

1555 (defvar yahtml:meta-names

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

1557

1558 (defun yahtml:meta ()

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

1560 "name"

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

1562 http-equiv content)

1563 (if (string= "" name)

1564 (if (string-match

1565 "Content-type"

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

1567 "http-equiv"

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

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

1570 "See docs/qanda")

1571 (concat http-equiv

1572 (yahtml-make-optional-argument

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

1574 (concat

1575 name

1576 (yahtml-make-optional-argument

1577 "content"

1578 (cond

1579 ((string-match "date" name)

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

1581 ((string-match "author" name)

1582 (read-string "Author: "

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

1584 (user-full-name)

1585 (user-login-name))))

1586 ((string-match "GENERATOR" name)

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

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

1589 (message "Thank you!"))

1590 content)

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

1592

1593 (defun yahtml:br ()

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

1595

1596 (defun yahtml:object ()

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

1598 data classid)

1599 (cond

1600 ((string-match "java" codetype)

1601 (let ((completion-ignored-extensions

1602 ;;any extensions except ".class"

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

1604 (setq classid (concat "java:"

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

1606 (concat

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

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

1609 (yahtml-make-optional-argument

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

1611 (yahtml-make-optional-argument

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

1613 (yahtml-make-optional-argument

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

1615 (t

1616 ""))))

1617

1618 (defun yahtml:abbr ()

1619 "Add-in function for abbr."

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

1621

1622 (defun yahtml:button ()

1623 (concat

1624 (yahtml-make-optional-argument

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

1626 (yahtml-make-optional-argument

1627 "type" (yahtml-read-parameter

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

1629 (yahtml-make-optional-argument

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

1631

1632 ;;; ---------- Simple tag ----------

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

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

1635 (interactive "P")

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

1637 (or tag

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

1639 (setq tag

1640 (YaTeX-cplread-with-learning

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

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

1643 'yahtml-typeface-table 'yahtml-user-typeface-table

1644 'yahtml-tmp-typeface-table))))

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

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

1647 (setq yahtml-last-typeface-cmd tag

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

1649 (if region-mode

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

1651 (save-excursion

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

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

1654 (exchange-point-and-mark)

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

1656 (message "No mark set now"))

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

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

1659

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

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

1662 (interactive)

1663 (yahtml-insert-tag t tag))

1664

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

1666 (defun yahtml-insert-single (cmd)

1667 "Insert <CMD>."

1668 (interactive

1669 (list

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

1671 (YaTeX-cplread-with-learning

1672 (format "Command%s: "

1673 (if yahtml-last-single-cmd

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

1675 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1678 (setq yahtml-last-single-cmd

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

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

1681 yahtml-last-single-cmd))

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

1683 cmd

1684 (yahtml-addin cmd)

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

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

1687 " /" "")))

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

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

1690

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

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

1693 (interactive "P")

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

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

1696

1697 (defun yahtml-insert-amps (arg)

1698 "Insert char-entity references via ampersand"

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

1700 (interactive "P")

1701 (let*((mess "") c

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

1703 yahtml-entity-reference-chars-alist))

1704 (l list))

1705 (while l

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

1707 l (cdr l)))

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

1709 (setq c (read-char))

1710 (cond

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

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

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

1714 (insert "&;")

1715 (forward-char -1))

1716 ((equal c ? )

1717 (insert ?&))

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

1719

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

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

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

1723

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

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

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

1727

1728 ;;; ---------- Jump ----------

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

1730 "Check if point is on href clause."

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

1732 (save-excursion

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

1734 (save-excursion

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

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

1737 (setq e (point)))

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

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

1740 (search-forward "href" e t)

1741 (search-forward "=" e t)

1742 (progn

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

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

1745 (< p (match-end 0))

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

1747

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

1749 (cond

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

1751 (set-process-buffer proc nil))

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

1753 (let ((cb (current-buffer)))

1754 (set-buffer (process-buffer proc))

1755 (goto-char (point-min))

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

1757 (progn

1758 (message "Starting netscape...")

1759 (start-process

1760 "browser" (process-buffer proc)

1761 shell-file-name yahtml-shell-command-option

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

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

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

1765 (set-buffer cb)))))

1766

1767 (defvar yahtml-browser-process nil)

1768

1769 (defun yahtml-browse-html (href)

1770 "Call WWW Browser to see HREF."

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

1772 (cond

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

1774 (if (get-buffer pb)

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

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

1777 (set-process-sentinel

1778 (setq yahtml-browser-process

1779 (start-process

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

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

1782 'yahtml-netscape-sentinel))

1783 ((and (string-match

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

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

1786 (if (get-buffer pb)

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

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

1789 (set-process-sentinel

1790 (setq yahtml-browser-process

1791 (start-process

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

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

1794 'yahtml-netscape-sentinel))

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

1796 (w3-fetch href))

1797 ((stringp yahtml-www-browser)

1798 (if (and yahtml-browser-process

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

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

1801 (setq yahtml-browser-process

1802 (start-process

1803 "browser" "* WWW Browser *"

1804 shell-file-name yahtml-shell-command-option

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

1806 (t

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

1808

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

1810 "Go to corresponding name."

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

1812 (if href

1813 (cond

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

1815 (yahtml-browse-html href))

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

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

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

1819 (if (string< "" file)

1820 (progn

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

1822 (or (catch 'dirindex

1823 (mapcar

1824 (function

1825 (lambda (f)

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

1827 (throw 'dirindex

1828 (setq file (concat file f))))))

1829 (yahtml-get-directory-index))

1830 nil)

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

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

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

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

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

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

1837 (if name

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

1839 t)))))

1840

1841 (defun yahtml-jump-to-name (name)

1842 "Jump to html's named tag."

1843 (setq name (format "\$name\\|id\$\\s *=\\s *\"?%s\\>\"?" name))

1844 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))

1845 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))

1846 (message "Named tag `%s' not found" (substring href 1))))

1847

1848 (defun yahtml-on-begend-p (&optional p)

1849 "Check if point is on begend clause."

1850 (let ((p (or p (point))) cmd (case-fold-search t))

1851 (save-excursion

1852 (goto-char p)

1853 (if (equal (char-after (point)) ?<) (forward-char 1))

1854 (if (and (re-search-backward "<" nil t)

1855 (looking-at

1856 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1857 "<\$/?[A-Z][A-Z0-9]*\$\\b")

1858 (condition-case nil

1859 (forward-list 1)

1860 (error nil))

1861 (< p (point)))

1862 (YaTeX-match-string 1)))))

1863

1864 (defun yahtml-goto-corresponding-begend (&optional noerr)

1865 "Go to corresponding opening/closing tag.

1866 Optional argument NOERR causes no error for unballanced tag."

1867 (let ((cmd (yahtml-on-begend-p)) m0

1868 (p (point)) (case-fold-search t) func str (nest 0))

1869 (cond

1870 (cmd

1871 (setq m0 (match-beginning 0))

1872 (if (= (aref cmd 0) ?/) ;on </cmd> line

1873 (setq cmd (substring cmd 1)

1874 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1875 func 're-search-backward)

1876 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1877 func 're-search-forward))

1878 (while (and (>= nest 0) (funcall func str nil t))

1879 (if (equal m0 (match-beginning 0))

1880 nil

1881 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1882 (if (< nest 0)

1883 (goto-char (match-beginning 0))

1884 (funcall

1885 (if noerr 'message 'error)

1886 "Corresponding tag of `%s' not found." cmd)

1887 (goto-char p)

1888 nil))

1889 (t nil))))

1890

1891 (defun yahtml-current-tag ()

1892 "Return the current tag name including #exec and #include."

1893 (save-excursion

1894 (let ((p (point)) b tag)

1895 (or (bobp)

1896 (looking-at "<")

1897 (progn (skip-chars-backward "^<") (forward-char -1)))

1898 (setq b (point))

1899 (skip-chars-forward "<")

1900 (setq tag (YaTeX-buffer-substring

1901 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1902 (goto-char b)

1903 (forward-list 1)

1904 (and (< p (point)) tag))))

1905

1906 (defun yahtml-get-attrvalue (attr)

1907 "Extract current tag's attribute value from buffer."

1908 (let (e (case-fold-search t))

1909 (save-excursion

1910 (or (looking-at "<")

1911 (progn (skip-chars-backward "^<") (backward-char 1)))

1912 (setq e (save-excursion (forward-list 1) (point)))

1913 (if (and

1914 (re-search-forward (concat "\\b" attr "\\b") e t)

1915 (progn (skip-chars-forward " \t\n=")

1916 (looking-at "\"?\$[^\"> \t\n]+\$\"?")))

1917 (YaTeX-match-string 1)))))

1918

1919 (defun yahtml-goto-corresponding-img ()

1920 "View image on point"

1921 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1922 (if (and tag

1923 (string-match "img" tag)

1924 (setq image

1925 (yahtml-unescape-string (yahtml-get-attrvalue "src"))))

1926 (progn

1927 (message "Invoking %s %s..." yahtml-image-viewer image)

1928 (start-process

1929 "Viewer" " * Image Viewer *"

1930 shell-file-name yahtml-shell-command-option ;"-c"

1931 (concat yahtml-image-viewer " " image))

1932 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1933

1934 (defun yahtml-goto-corresponding-source (&optional other)

1935 "Goto applet's or script's source."

1936 (let ((env (yahtml-current-tag)) s (p (point)))

1937 (cond

1938 ((string-match "applet" env)

1939 (if (setq s (yahtml-unescape-string (yahtml-get-attrvalue "code")))

1940 (progn

1941 (setq s (YaTeX-match-string 1)

1942 s (concat

1943 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1944 ".java"))

1945 (if other (YaTeX-switch-to-buffer-other-window s)

1946 (YaTeX-switch-to-buffer s))

1947 s) ;return source file name

1948 (message "No applet source specified")

1949 (sit-for 1)

1950 nil))

1951 ((string-match "script" env)

1952 (if (setq s (yahtml-get-attrvalue "src"))

1953 (progn

1954 (funcall (if other 'YaTeX-switch-to-buffer-other-window

1955 'YaTeX-switch-to-buffer)

1956 (yahtml-url-to-path s))

1957 s)))

1958 ((string-match "!--#include" env)

1959 (cond

1960 ((setq s (yahtml-get-attrvalue "file")) ;

1961 (if other (YaTeX-switch-to-buffer-other-window s)

1962 (YaTeX-switch-to-buffer s))

1963 s)

1964 ((setq s (yahtml-get-attrvalue "virtual"));

1965 (setq s (yahtml-url-to-path s))

1966 (if other (YaTeX-switch-to-buffer-other-window s)

1967 (YaTeX-switch-to-buffer s))

1968 s)))

1969 ((and (string-match "!--#exec" env)

1970 (setq s (yahtml-get-attrvalue "cmd")))

1971 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1972 (let ((b " *yahtmltmp*")) ;peek a little

1973 (unwind-protect

1974 (progn

1975 (set-buffer (get-buffer-create b))

1976 (YaTeX-insert-file-contents s nil 0 100)

1977 (if (looking-at "#!")

1978 (if other (YaTeX-switch-to-buffer-other-window s)

1979 (YaTeX-switch-to-buffer s))))

1980 (kill-buffer (get-buffer b)))

1981 (get-file-buffer s))))))

1982

1983 (defun yahtml-goto-corresponding-* (&optional other)

1984 "Go to corresponding object."

1985 (interactive "P")

1986 (cond

1987 ((yahtml-goto-corresponding-href other))

1988 ((yahtml-goto-corresponding-img))

1989 ((yahtml-goto-corresponding-source other))

1990 ((yahtml-goto-corresponding-begend))

1991 (t (message "I don't know where to go."))))

1992

1993 (defun yahtml-goto-corresponding-*-other-window ()

1994 "Go to corresponding object."

1995 (interactive)

1996 (yahtml-goto-corresponding-* t))

1997

1998 (defun yahtml-visit-main ()

1999 "Go to parent file from where you visit current file."

2000 (interactive)

2001 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

2002

2003 ;;; ---------- killing ----------

2004 (defun yahtml-kill-begend (&optional whole)

2005 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

2006 (if tag

2007 (save-excursion

2008 (or (looking-at "<")

2009 (progn (skip-chars-backward "^<") (forward-char -1)))

2010 (setq p (point))

2011 (yahtml-goto-corresponding-begend)

2012 (or (looking-at "<")

2013 (progn (skip-chars-backward "^<") (forward-char -1)))

2014 (if (< (point) p) ;if on the opening tag

2015 (progn (setq q p p (point))

2016 (goto-char q))

2017 (setq q (point))) ;now q has end-line's (point)

2018 (if (not whole)

2019 (kill-region

2020 (progn (skip-chars-backward " \t")

2021 (if (setq bbolp (bolp)) (point) q))

2022 (progn (forward-list 1)

2023 (setq r (point))

2024 (skip-chars-forward " \t")

2025 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

2026 (goto-char p)

2027 (skip-chars-backward " \t")

2028 (if (not whole)

2029 (progn

2030 (kill-append

2031 (buffer-substring

2032 (setq p (if (setq bbolp (bolp)) (point) p))

2033 (setq q (progn

2034 (forward-list 1)

2035 (setq r (point))

2036 (skip-chars-forward " \t")

2037 (if (and bbolp (eolp) (not (eobp)))

2038 (1+ (point))

2039 r))))

2040 t)

2041 (delete-region p q))

2042 (kill-region

2043 (if (bolp) (point) p)

2044 (progn (goto-char q)

2045 (forward-list 1)

2046 (setq r (point))

2047 (skip-chars-forward " \t")

2048 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

2049 tag))))

2050

2051 (defun yahtml-kill-* (whole)

2052 "Kill current position's HTML tag (set)."

2053 (interactive "P")

2054 (cond

2055 ((yahtml-kill-begend whole))))

2056

2057

2058 ;;; ---------- changing ----------

2059 (defun yahtml-on-assignment-p ()

2060 "Return if current point is on parameter assignment.

2061 If so, return parameter name, otherwise nil.

2062 This function should be able to treat white spaces in value, but not yet."

2063 (let ((p (point)))

2064 (save-excursion

2065 (put 'yahtml-on-assignment-p 'region nil)

2066 (skip-chars-backward "^ \t\n")

2067 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

2068 (< p (match-end 0))

2069 (>= p (1- (match-beginning 2)))

2070 (put 'yahtml-on-assignment-p 'region

2071 (cons (match-beginning 2) (match-end 2)))

2072 (YaTeX-match-string 1)))))

2073

2074 (defun yahtml-change-begend ()

2075 (let ((tag (yahtml-on-begend-p))

2076 (completion-ignore-case t)

2077 (case-fold-search t)

2078 (p (point)) (q (make-marker))

2079 (default (append yahtml-env-table yahtml-typeface-table))

2080 (user (append yahtml-user-env-table yahtml-user-typeface-table))

2081 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

2082 href b1 e1 attr new css)

2083 (cond

2084 (tag

2085 (cond

2086 ((and (string-match "^a$" tag)

2087 (save-excursion

2088 (and

2089 (re-search-backward "<a\\b" nil t)

2090 (progn

2091 (goto-char (match-end 0))

2092 (skip-chars-forward " \t\n")

2093 (setq b1 (point))

2094 (search-forward ">" nil t))

2095 (setq e1 (match-beginning 0))

2096 (goto-char b1)

2097 (re-search-forward "href\\s *=" e1 t)

2098 (>= p (point))

2099 (progn

2100 (goto-char (match-end 0))

2101 (skip-chars-forward " \t\n")

2102 (looking-at "\"?\$[^\"> \t\n]+\$\"?"))

2103 (< p (match-end 0)))))

2104 (setq b1 (match-beginning 1) e1 (match-end 1)

2105 yahtml-completing-buffer (current-buffer)

2106 ;; yahtml-urls-local is buffer-local, so we must put

2107 ;; that into yahtml-urls here

2108 yahtml-urls (append yahtml-urls-private yahtml-urls-local)

2109 href (read-from-minibuffer

2110 "Change href to: " "" yahtml-url-completion-map))

2111 (if (string< "" href)

2112 (progn

2113 ;;(setq href ;??

2114 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

2115 (delete-region b1 e1)

2116 (goto-char b1)

2117 (insert href))))

2118 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

2119 (if (and (equal attr "class") ;treat "class" attribute specially

2120 (setq css (yahtml-css-get-element-completion-alist tag)))

2121

2122 (setq new (yahtml-read-css css))

2123 ;;other than "class", read parameter normally

2124 (setq new (yahtml-read-parameter attr)))

2125 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

2126 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

2127 (insert new))

2128 (t

2129 (save-excursion

2130 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

2131 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

2132 (skip-chars-forward "^A-Za-z")

2133 (set-marker q (point))

2134 (setq p (point))

2135 (yahtml-goto-corresponding-begend)

2136 (or (= (char-after (point)) ?<)

2137 (skip-chars-backward "^<"))

2138 (skip-chars-forward "^A-Za-z")

2139 (if (= (char-after (1- (point))) ?/)

2140 (progn

2141 (set-marker q (point))

2142 (goto-char p)))

2143 (setq tag (let ((completion-ignore-case t))

2144 (YaTeX-cplread-with-learning

2145 (format "Change `%s' to(default %s): "

2146 tag yahtml-last-begend)

2147 'default 'user 'tmp)))

2148 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2149 (if (string= "" tag) (setq tag yahtml-last-begend))

2150 (setq yahtml-last-begend

2151 (or (cdr (assoc tag yahtml-env-table)) tag)

2152 tag yahtml-last-begend)

2153 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

2154 (insert (format "%s%s" tag (yahtml-addin tag)))

2155 (goto-char q)

2156 (set-marker q nil)

2157 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

2158 (insert tag))))

2159 t))))

2160

2161 (defun yahtml-change-command ()

2162 (let ((p (point)) (case-fold-search t) cmd par new

2163 (beg (make-marker)) (end (make-marker)))

2164 (skip-chars-backward "^<")

2165 (if (and

2166 (looking-at yahtml-command-regexp)

2167 (progn

2168 (set-marker beg (match-beginning 0))

2169 (set-marker end (match-end 0))

2170 t) ;for further work

2171 (progn

2172 (forward-char -1)

2173 (condition-case nil

2174 (forward-list 1)

2175 (error nil))

2176 (< p (point))))

2177 (progn

2178 (goto-char p)

2179 (if (setq par (yahtml-on-assignment-p))

2180 (progn

2181 (setq new (yahtml-read-parameter par))

2182 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

2183 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

2184 (setq new

2185 (YaTeX-cplread-with-learning

2186 "Change form to: "

2187 'yahtml-form-table 'yahtml-user-form-table

2188 'yahtml-tmp-form-table)))

2189 (delete-region beg end)

2190 (goto-char beg)

2191 (set-marker beg nil)

2192 (set-marker end nil)

2193 (insert new)

2194 t)

2195 (goto-char p)

2196 nil)))

2197

2198 (defun yahtml-change-* ()

2199 "Change current position's HTML tag (set)."

2200 (interactive)

2201 (cond

2202 ((yahtml-change-begend))

2203 ((yahtml-change-command))))

2204

2205 ;;; ---------- commenting ----------

2206

2207 (defun yahtml-comment-region (&optional uncom)

2208 "Comment out region or environment."

2209 (interactive)

2210 (let ((e (make-marker)) be beg p)

2211 (cond

2212 (;(marker-position (set-marker e (yahtml-on-begend-p)))

2213 (setq be (yahtml-on-begend-p))

2214 (save-excursion

2215 (setq p (point))

2216 (if (string-match "^/" be)

2217 (setq beg (progn (forward-line 1) (point)))

2218 (setq beg (progn (beginning-of-line) (point))))

2219 (goto-char p)

2220 (yahtml-goto-corresponding-begend)

2221 (if (string-match "^/" be)

2222 (beginning-of-line)

2223 (forward-line 1))

2224 (set-marker e (point))

2225 ;(comment-region beg (point) (if uncom (list 4)))))

2226 ))

2227 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

2228 (setq beg (region-beginning))

2229 (set-marker e (region-end))))

2230 (if yahtml-translate-hyphens-when-comment-region

2231 (let ((yahtml-entity-reference-chars-alist-default nil)

2232 (yahtml-entity-reference-chars-alist '((?- . "#45")))

2233 yahtml-entity-reference-chars-regexp

2234 yahtml-entity-reference-chars-reverse-regexp)

2235 (yahtml-entity-reference-chars-setup)

2236 (funcall

2237 (if uncom 'yahtml-translate-reverse-region

2238 'yahtml-translate-region)

2239 beg e)))

2240 (comment-region beg e (if uncom (list 4)))

2241 (set-marker e nil)))

2242

2243 (defun yahtml-uncomment-region ()

2244 (interactive)

2245 (yahtml-comment-region t))

2246

2247 ;;; ---------- translate to entity references ----------

2248 (defvar yahtml-entity-reference-chars-alist-default

2249 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

2250 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

2251 "Default translation table from character to entity reference")

2252 (defvar yahtml-entity-reference-chars-alist nil

2253 "*Translation table from character to entity reference")

2254 (defvar yahtml-entity-reference-chars-regexp nil)

2255 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2256

2257 (defun yahtml-entity-reference-chars-setup ()

2258 (let ((list (append yahtml-entity-reference-chars-alist-default

2259 yahtml-entity-reference-chars-alist)))

2260 (setq yahtml-entity-reference-chars-regexp "["

2261 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2262 (while list

2263 (setq yahtml-entity-reference-chars-regexp

2264 (concat yahtml-entity-reference-chars-regexp

2265 (char-to-string (car (car list))))

2266 yahtml-entity-reference-chars-reverse-regexp

2267 (concat yahtml-entity-reference-chars-reverse-regexp

2268 (cdr (car list))

2269 (if (cdr list) "\\|")))

2270 (setq list (cdr list)))

2271 (setq yahtml-entity-reference-chars-regexp

2272 (concat yahtml-entity-reference-chars-regexp "]")

2273 yahtml-entity-reference-chars-reverse-regexp

2274 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2275

2276 (yahtml-entity-reference-chars-setup)

2277

2278 (defun yahtml-translate-region (beg end)

2279 "Translate inhibited literals."

2280 (interactive "r")

2281 (save-excursion

2282 (save-restriction

2283 (narrow-to-region beg end)

2284 (let ((ct (append yahtml-entity-reference-chars-alist

2285 yahtml-entity-reference-chars-alist-default)))

2286 (goto-char beg)

2287 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2288 ;(setq c (preceding-char))

2289 (replace-match

2290 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2291

2292 (defun yahtml-translate-reverse-region (beg end)

2293 "Translate entity references to literals."

2294 (interactive "r")

2295 (save-excursion

2296 (save-restriction

2297 (narrow-to-region beg end)

2298 (let ((ct (append yahtml-entity-reference-chars-alist

2299 yahtml-entity-reference-chars-alist-default))

2300 ec)

2301 (goto-char beg)

2302 (while (re-search-forward

2303 yahtml-entity-reference-chars-reverse-regexp nil t)

2304 ;(setq c (preceding-char))

2305 (setq ec (YaTeX-match-string 1))

2306 (delete-region (match-end 0) (match-beginning 0))

2307 (insert (car (YaTeX-rassoc ec ct))))))))

2308

2309 (defun yahtml-inner-environment-but (exclude &optional quick)

2310 "Return the inner environment but matches with EXCLUDE tag."

2311 (let (e (case-fold-search t))

2312 (save-excursion

2313 (while (and (setq e (YaTeX-inner-environment quick))

2314 (string-match exclude e))

2315 (goto-char (get 'YaTeX-inner-environment 'point))))

2316 e))

2317

2318 (defun yahtml-untranslate-string (str)

2319 "Untranslate entity reference."

2320 (let ((md (match-data)) (left "") (right str) b0 ch

2321 (ct (append yahtml-entity-reference-chars-alist

2322 yahtml-entity-reference-chars-alist-default))

2323 (revrex yahtml-entity-reference-chars-reverse-regexp))

2324 (unwind-protect

2325 (progn

2326 (while (string< "" right)

2327 (cond

2328 ((string-match revrex right)

2329 (setq ch (YaTeX-rassoc

2330 (substring right (match-beginning 1) (match-end 1)))

2331 b0 (substring right 0 (match-beginning 0))

2332 right (substring right (match-end 0))

2333 left (concat left

2334 (substring right 0 (match-beginning 0))

2335 (char-to-string ch))))

2336 ((string-match "\\&#\$x\$?\$[0-9a-f]+\$;" right)

2337 (setq ch (substring right (match-beginning 2) (match-end 2))

2338 b0 (substring right 0 (match-beginning 0))

2339 right (substring right (match-end 0))

2340 left (concat left

2341 b0

2342 (char-to-string

2343 (if (match-beginning 1)

2344 (YaTeX-hex ch)

2345 (string-to-number ch))))))

2346 (t (setq left (concat left right)

2347 right ""))))

2348 left)

2349 (store-match-data md))))

2350

2351 ;;; ---------- table-ize region ----------

2352 (defun yahtml-td-region (e delim beg end)

2353 "Enclose each item in a region with <td>..</td>.

2354 Interactive prefix argument consults enclosing element other than td."

2355 (interactive "P\nsDelimiter(s): \nr")

2356 (let ((e (cond

2357 ((null e) "td")

2358 ((stringp e) e)

2359 (t (read-string "Enclose with(`thd' means th td td..): " "th"))))

2360 (ws "[ \t]")

2361 elm p i)

2362 (if (string= delim "") (setq delim " \t\n"))

2363 (setq delim (concat "[" delim "]+")

2364 elm (if (string= "thd" e)

2365 (cons "th" "td")

2366 (cons e e)))

2367 (save-excursion

2368 (save-restriction

2369 (narrow-to-region beg end)

2370 (goto-char (setq p (point-min)))

2371 (setq i 0 e (car elm))

2372 (while (re-search-forward delim nil t)

2373 (setq e (if (= (setq i (1+ i)) 1) (car elm) (cdr elm)))

2374 (goto-char (match-beginning 0))

2375 (insert "</" e ">")

2376 (save-excursion

2377 (goto-char p)

2378 (insert "<" e ">"))

2379 (setq p (point))

2380 (while (and (not (eobp)) (looking-at ws))

2381 (delete-char 1))

2382 (if (looking-at delim) (delete-char 1)))

2383 (insert "<" e ">")

2384 (goto-char (point-max))

2385 (insert "</" e ">")))))

2386

2387 (defun yahtml-tr-region (e delim beg end)

2388 "Enclose lines in a form tab-sv/csv with <tr><td>..</td></tr>."

2389 (interactive "P\nsDelimiter(s): \nr")

2390 (setq e (if (and e (listp e))

2391 (read-string "Enclose with(td or th, `thd' -> th td td td...: "

2392 "th")))

2393 (save-excursion

2394 (save-restriction

2395 (narrow-to-region (point) (mark))

2396 (goto-char (point-min))

2397 (while (not (eobp))

2398 (insert "<tr>")

2399 (yahtml-td-region e delim (point) (point-end-of-line))

2400 (end-of-line)

2401 (insert "</tr>")

2402 (forward-line 1)))))

2403

2404 ;;; ---------- filling ----------

2405 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2406 (defun yahtml-move-to-column (col &optional force)

2407 (beginning-of-line)

2408 (let ((ccol 0))

2409 (while (and (> col ccol) (not (eolp)))

2410 (if (eq (following-char) ?\<)

2411 (progn

2412 (while (and (not (eq (following-char) ?\>))

2413 (not (eolp)))

2414 (forward-char))

2415 (or (eolp) (forward-char)))

2416 (or (eolp) (forward-char))

2417 (if (eq (preceding-char) ?\t)

2418 (let ((wd (- 8 (% (+ ccol 8) 8))))

2419 (if (and force (< col (+ ccol wd)))

2420 (progn

2421 (backward-char 1)

2422 (insert-char ?\ (- col ccol))

2423 (setq ccol col))

2424 (setq ccol (+ ccol wd))))

2425 (setq ccol (1+ ccol)))

2426 (if (and YaTeX-japan

2427 (or

2428 (and (fboundp 'char-category)

2429 (string-match "[chj]" (char-category (preceding-char))))

2430 (and (fboundp 'char-charset)

2431 (not (eq (char-charset (preceding-char)) 'ascii)))))

2432 (setq ccol (1+ ccol)))))

2433 (if (and force (> col ccol))

2434 (progn

2435 (insert-char ?\ (- col ccol))

2436 col)

2437 ccol)))

2438

2439 (defun yahtml-fill-paragraph (arg)

2440 (interactive "P")

2441 (let*((case-fold-search t) (p (point)) fill-prefix

2442 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2443 indent

2444 (startp (get 'YaTeX-inner-environment 'point))

2445 (prep (string-match "^pre$" e))

2446 (ps1 (if prep (default-value 'paragraph-start)

2447 paragraph-start))

2448 (ps2 (if prep (concat (default-value 'paragraph-start)

2449 "$\\|^\\s *</?pre>")

2450 paragraph-start)))

2451 (save-excursion

2452 (unwind-protect

2453 (progn

2454 (if prep

2455 (fset 'move-to-column 'yahtml-move-to-column))

2456 (save-excursion

2457 (beginning-of-line)

2458 (indent-to-column (yahtml-this-indent))

2459 (setq fill-prefix

2460 (buffer-substring (point) (point-beginning-of-line)))

2461 (delete-region (point) (point-beginning-of-line)))

2462 (fill-region-as-paragraph

2463 (progn (re-search-backward paragraph-start nil t)

2464 (or (save-excursion

2465 (goto-char (match-beginning 0))

2466 (if (looking-at "<")

2467 (forward-list)

2468 (goto-char (match-end 0))

2469 (skip-chars-forward " \t>"))

2470 (if (looking-at "[ \t]*$")

2471 (progn (forward-line 1) (point))))

2472 (point)))

2473 (progn (goto-char p)

2474 (re-search-forward ps2 nil t)

2475 (match-beginning 0))))

2476 (fset 'move-to-column yahtml-saved-move-to-column)))))

2477

2478 ;(defun yahtml-indent-new-commnet-line ()

2479 ; (unwind-protect

2480 ; (progn

2481 ; (fset 'move-to-column 'yahtml-move-to-column)

2482 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2483 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2484

2485 ;;;

2486 ;;; ---------- indentation ----------

2487 ;;;

2488 (defun yahtml-indent-line ()

2489 "Indent a line (faster wrapper)"

2490 (interactive)

2491 (let (indent)

2492 (if (and (save-excursion

2493 (beginning-of-line) (skip-chars-forward "\t ")

2494 (not (looking-at "<")))

2495 (save-excursion

2496 (forward-line -1)

2497 (while (and (not (bobp)) (looking-at "^\\s *$"))

2498 (forward-line -1))

2499 (skip-chars-forward "\t ")

2500 (setq indent (current-column))

2501 (not (looking-at "<"))))

2502 (progn

2503 (save-excursion

2504 (beginning-of-line)

2505 (skip-chars-forward " \t")

2506 (or (= (current-column) indent)

2507 (YaTeX-reindent indent)))

2508 (and (bolp) (skip-chars-forward " \t")))

2509 (yahtml-indent-line-real))))

2510

2511 (defun yahtml-this-indent ()

2513 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2514 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2515 (excludes

2516 "\$a\\|p\\|span\\|code\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2517 inenv p col peol (case-fold-search t))

2518 (save-excursion

2519 (beginning-of-line)

2520 (setq inenv (or (yahtml-inner-environment-but excludes t)

2521 "html")

2522 col (get 'YaTeX-inner-environment 'indent)

2523 p (get 'YaTeX-inner-environment 'point)

2524 op nil))

2525 (save-excursion

2526 (cond

2527 ((string-match (concat "^\$" envs "\$") inenv)

2528 (save-excursion

2529 (beginning-of-line)

2530 (skip-chars-forward " \t")

2531 (cond ;lookup current line's tag

2532 ((looking-at (concat "</\$" envs "\$>"))

2533 col)

2534 ((looking-at itms)

2535 (+ col yahtml-environment-indent))

2536 ((and yahtml-hate-too-deep-indentation

2537 (looking-at (concat "<\$" envs "\$")))

2538 (+ col (* 2 yahtml-environment-indent)))

2539 ((and (< p (point))

2540 (string-match itemizing-envs inenv)

2541 (save-excursion

2542 (and

2543 (setq op (point))

2544 (goto-char p)

2545 (re-search-forward itms op t)

2546 (progn

2547 (if yahtml-indent-listing-constant

2548 (setq col (+ (current-column)

2549 (if yahtml-faithful-to-htmllint 1 2)))

2550 (skip-chars-forward "^>")

2551 (skip-chars-forward ">")

2552 (skip-chars-forward " \t")

2553 (setq col (if (looking-at "$")

2554 (+ col yahtml-environment-indent)

2555 (current-column))))))))

2556 col)

2557 (t

2558 (+ col yahtml-environment-indent)))))

2559 (t col)))))

2560

2561 (defun yahtml-indent-line-real ()

2562 "Indent current line."

2563 (interactive)

2564 (YaTeX-reindent (yahtml-this-indent))

2565 (if (bolp) (skip-chars-forward " \t"))

2566 (let (peol col inenv)

2567 (if (and (setq inenv (yahtml-on-begend-p))

2568 (string-match

2569 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2570 (save-excursion

2571 (setq peol (point-end-of-line))

2572 (or (= (char-after (point)) ?<)

2573 (progn (skip-chars-backward "^<") (forward-char -1)))

2574 (setq col (current-column))

2575 (if (and (yahtml-goto-corresponding-begend t)

2576 (> (point) peol)) ;if on the different line

2577 (YaTeX-reindent col))))))

2578

2579 ;(defun yahtml-fill-item ()

2580 ; "Fill item HTML version"

2581 ; (interactive)

2582 ; (let (inenv p fill-prefix peol (case-fold-search t))

2583 ; (setq inenv (or (YaTeX-inner-environment) "html")

2584 ; p (get 'YaTeX-inner-environment 'point))

2585 ; (cond

2586 ; ((string-match "^[uod]l" inenv)

2587 ; (save-excursion

2588 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2589 ; (progn

2590 ; (goto-char (match-end 0))

2591 ; (setq col (current-column)))

2592 ; (error "No <li>, <dt>, <dd>")))

2593 ; (save-excursion

2594 ; (end-of-line)

2595 ; (setq peol (point))

2596 ; (newline)

2597 ; (indent-to-column col)

2598 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2599 ; (delete-region (point) peol)

2600 ; (fill-region-as-paragraph

2601 ; (progn (re-search-backward paragraph-start nil t) (point))

2602 ; (progn (re-search-forward paragraph-start nil t 2)

2603 ; (match-beginning 0)))))

2604 ; (t nil))))

2605

2606 ;;;

2607 ;;; ---------- Lint and Browsing ----------

2608 ;;;

2609 (defun yahtml-browse-menu ()

2610 "Browsing or other external process invokation menu."

2611 (interactive)

2612 (message "J)weblint p)Browse R)eload N)ewpage...")

2613 (let ((c (char-to-string (read-char))))

2614 (cond

2615 ((string-match "j" c)

2616 (yahtml-lint-buffer (current-buffer)))

2617 ((string-match "[bp]" c)

2618 (yahtml-browse-current-file))

2619 ((string-match "r" c)

2620 (yahtml-browse-reload))

2621 ((string-match "n" c)

2622 (call-interactively 'yahtml-newpage)))))

2623

2624 (if (fboundp 'wrap-function-to-control-ime)

2625 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2626

2627 (defvar yahtml-lint-buffer "*weblint*")

2628

2629 (defun yahtml-lint-buffer (buf)

2630 "Call lint on buffer BUF."

2631 (require 'yatexprc)

2632 (interactive "bCall lint on buffer: ")

2633 (setq buf (get-buffer buf))

2634 (YaTeX-save-buffers)

2635 (let ((bcmd (YaTeX-get-builtin "lint")))

2636 (and bcmd (setq bcmd (yahtml-untranslate-string bcmd)))

2637 (YaTeX-typeset

2638 (concat (or bcmd yahtml-lint-program)

2639 " " (file-name-nondirectory (buffer-file-name buf)))

2640 yahtml-lint-buffer "lint" "lint")))

2641

2642 (defun yahtml-file-to-url (file)

2643 "Convert local unix file name to URL.

2644 If no matches found in yahtml-path-url-alist, return raw file name."

2645 (let ((list yahtml-path-url-alist) p url)

2646 (if (file-directory-p file)

2647 (setq file (expand-file-name yahtml-directory-index file))

2648 (setq file (expand-file-name file)))

2649 (if (string-match "^[A-Za-z]:/" file)

2650 (progn

2651 ;; (aset file 1 ?|) ;これは要らないらしい…

2652 (setq file (concat "///" file))))

2653 (while list

2654 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2655 (setq url (cdr (car list))

2656 file (substring file (match-end 0))

2657 url (concat url file)

2658 list nil))

2659 (setq list (cdr list)))

2660 (or url (concat "file:" file))))

2661

2662 (defun yahtml-url-to-path (file &optional basedir)

2663 "Convert local URL name to unix file name."

2664 (let ((list yahtml-path-url-alist) url realpath docroot

2665 (dirsufp (string-match "/$" file)))

2666 (setq basedir (or basedir

2667 (file-name-directory

2668 (expand-file-name default-directory))))

2669 (cond

2670 ((string-match "^/" file)

2671 (while list

2672 (if (file-directory-p (car (car list)))

2673 (progn

2674 (setq url (cdr (car list)))

2675 (if (string-match "\$http://[^/]*\$/" url)

2676 (setq docroot (substring url (match-end 1)))

2677 (setq docroot url))

2678 (cond

2679 ((string-match (concat "^" (regexp-quote docroot)) file)

2680 (setq realpath

2681 (expand-file-name

2682 (substring

2683 file

2684 (if (= (aref file (1- (match-end 0))) ?/)

2685 (match-end 0) ; "/foo"

2686 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2687 (car (car list))))))

2688 (if realpath

2689 (progn (setq list nil)

2690 (if (and dirsufp (not (string-match "/$" realpath)))

2691 (setq realpath (concat realpath "/")))))))

2692 (setq list (cdr list)))

2693 realpath)

2694 (t file))))

2695

2696 (defun yahtml-browse-current-file ()

2697 "Call WWW browser on current file."

2698 (interactive)

2699 (basic-save-buffer)

2700 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2701

2702 (defun yahtml-browse-reload ()

2703 "Send `reload' event to netscape."

2704 (let ((pb "* WWW Browser *") (cb (current-buffer)))

2705 (cond

2706 ((string-match "[Nn]etscape" yahtml-www-browser)

2707 (if (get-buffer pb)

2708 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))

2709 ;;(or (get 'yahtml-netscape-sentinel 'url)

2710 ;; (error "Reload should be called after Browsing."))

2711 (put 'yahtml-netscape-sentinel 'url

2712 (yahtml-file-to-url (buffer-file-name)))

2713 (basic-save-buffer)

2714 (set-process-sentinel

2715 (setq yahtml-browser-process

2716 (start-process

2717 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"

2718 (format "%s -remote 'reload'" yahtml-www-browser)))

2719 'yahtml-netscape-sentinel))

2720 (t

2721 (message "Sorry, RELOAD is supported only for Netscape.")))))

2722

2723 ;;; ---------- Intelligent newline ----------

2724 (defun yahtml-intelligent-newline (arg)

2725 "Intelligent newline for HTML"

2726 (interactive "P")

2727 (let (env func)

2728 (end-of-line)

2729 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2730 "html")))

2731 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2732 (newline)

2733 (if (and env func (fboundp func))

2734 ;; if intelligent line function is defined, call that

2735 (funcall func)

2736 ;; else do the default action

2737 (if (string-match yahtml-p-prefered-env-regexp env)

2738 (yahtml-insert-p)))))

2739

2740 (defun yahtml-intelligent-newline-ul ()

2741 (interactive)

2742 (yahtml-insert-single "li")

2743 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2744 (yahtml-indent-line))

2745

2746 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2747

2748 (defun yahtml-intelligent-newline-dl ()

2749 (interactive)

2750 (let ((case-fold-search t))

2751 (if (save-excursion

2752 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)[ \t>]"

2753 (get 'YaTeX-inner-environment 'point) t))

2754 (cond

2755 ((match-beginning 2)

2756 (yahtml-insert-single "dd")

2757 (or yahtml-always-/dd yahtml-faithful-to-htmllint (insert " "))

2758 (setq yahtml-last-single-cmd "dt"))

2759 ((match-beginning 3)

2760 (yahtml-insert-single "dt")

2761 (or yahtml-always-/dt yahtml-faithful-to-htmllint (insert " "))

2762 (setq yahtml-last-single-cmd "dd")))

2763 (yahtml-insert-single "dt")

2764 (or yahtml-always-/li yahtml-faithful-to-htmllint (insert " "))

2765 (setq yahtml-last-single-cmd "dd"))

2766 (yahtml-indent-line)

2767 (and (string-match yahtml-p-prefered-env-regexp "dl")

2768 (string-equal yahtml-last-single-cmd "dt")

2769 (yahtml-insert-p nil))))

2770

2771 (defun yahtml-intelligent-newline-select ()

2772 (interactive)

2773 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2774 (yahtml-indent-line))

2775

2776 (defun yahtml-intelligent-newline-style ()

2777 (interactive)

2778 (if (save-excursion

2779 (and

2780 (re-search-backward "<style\\|<!-- " nil t)

2781 (looking-at "<style")))

2782 (let (c)

2783 (yahtml-indent-line)

2784 (setq c (current-column))

2785 (insert "<!--\n")

2786 (YaTeX-reindent c)

2787 (insert "-->")

2788 (beginning-of-line)

2789 (open-line 1)

2790 (YaTeX-reindent c))))

2791

2792 (defun yahtml-intelligent-newline-head ()

2793 (let ((title (read-string "Document title: "))

2794 (b "<title>") (e "</title>") p)

2795 (yahtml-indent-line)

2796 (insert (format "%s" (if yahtml-prefer-upcases (upcase b) b)))

2797 (setq p (point))

2798 (insert (format "%s%s" title (if yahtml-prefer-upcases (upcase e) e)))

2799 (if (string= "" title) (goto-char p))

2800 (setq yahtml-last-begend "body")))

2801

2802 (defun yahtml-intelligent-newline-script ()

2803 (let ((p (point)) b)

2804 (if (save-excursion

2805 (and

2806 (setq b (re-search-backward "<script\\>" nil t))

2807 (re-search-forward

2808 "\$javascript\$\\|\$tcl\$\\|\$vbscript\$" p t)))

2809 (let ((js (match-end 1)) (tcl (match-end 2)) (vb (match-end 3))

2810 c (srcp (re-search-backward "src=" b t)))

2811 (goto-char p)

2812 (yahtml-indent-line)

2813 (setq c (current-column))

2814 (if srcp

2815 nil

2816 (insert "")

2817 (beginning-of-line)

2818 (open-line 1)

2819 (YaTeX-reindent c))))))

2820

2821 (defun yahtml-intelligent-newline-table ()

2822 (let ((cp (point)) (p (point)) tb rb (cols 0) th line (i 0) fmt

2823 (ptn "\$<t[dh]\\>\$\\|<t\$r\\|head\\|body\$\\>"))

2824 (cond

2825 ((save-excursion (setq tb (YaTeX-beginning-of-environment "table")))

2826 (while (and (setq rb (re-search-backward ptn tb t))

2827 (match-beginning 1))

2828 (setq th (looking-at "<th")) ;Remember if first-child is tr or not

2829 (goto-char (match-end 0))

2830 (skip-chars-forward " \t\n")

2831 (if (and (search-forward "colspan\\s *=" p t)

2832 (progn

2833 (skip-chars-forward "\"' \t\n")

2834 (looking-at "[0-9]+")))

2835 (setq cols (+ (string-to-int (YaTeX-match-string 0)) cols))

2836 (setq cols (1+ cols)))

2837 (goto-char rb)

2838 (setq p (point)))

2839 (if (> cols 0)

2840 (message "%s columns found. %s"

2841 cols (if YaTeX-japan "新しいtr(N)? 前のtrの複写?(D)?: "

2842 "New tr?(N) or Duplicate")))

2843 (cond

2844 ((and (> cols 0)

2845 (memq (read-char) '(?d ?D))) ;Duplication mode

2846 (setq line (YaTeX-buffer-substring (point) (1- cp))))

2847 (t ;empty cells

2848 (setq line "<tr>" i 0)

2849 (if (> cols 0)

2850 (while (> cols i)

2851 (setq line (concat line (if (and (= i 0) th) "<th></th>"

2852 "<td></td>"))

2853 th nil i (1+ i)))

2854 (setq fmt (read-string "`th' or `td' format: " "th td td"))

2855 (while (string-match "t\$h\$\\|td" fmt i)

2856 (setq line (concat line (if (match-beginning 1) "<th></th>"

2857 "<td></td>"))

2858 i (match-end 0))))

2859 (setq line (concat line "</tr>"))))

2860 (goto-char cp)

2861 (if th

2862 (message

2863 "Type `%s' to change td from/to th."

2864 (key-description (car (where-is-internal 'yahtml-change-*)))))

2865 (if (string< "" line)

2866 (progn

2867 (insert line)

2868 (goto-char (+ 8 cp))

2869 (yahtml-indent-line)))))))

2870

2871 ;;; ---------- Marking ----------

2872 (defun yahtml-mark-begend ()

2873 "Mark current tag"

2874 (interactive)

2875 (YaTeX-beginning-of-environment)

2876 (let ((p (point)))

2877 (save-excursion

2878 (skip-chars-backward " \t" (point-beginning-of-line))

2879 (if (bolp) (setq p (point))))

2880 (push-mark p t))

2881 (yahtml-goto-corresponding-begend)

2882 (forward-list 1)

2883 (if (eolp) (forward-char 1)))

2884

2885 ;;; ---------- complete marks ----------

2886 (defun yahtml-complete-mark ()

2887 "Complete &gt, &lt, &ampersand, and &quote."

2888 (interactive)

2889 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2890 (let ((c (read-char)))

2891 (setq c (if (or (< c ?0) (> c ?7))

2892 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2893 (- c ?1)))

2894 (if (or (< c 0) (> c 6))

2895 nil

2896 (insert (format "&%s;"

2897 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2898

2899

2900 ;;; ---------- jump to error line ----------

2901 (defun yahtml-prev-error ()

2902 "Jump to previous error seeing lint buffer."

2903 (interactive)

2904 (or (get-buffer yahtml-lint-buffer)

2905 (error "No lint program ran."))

2906 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2907 (yahtml-jump-to-error-line t))

2908

2909 (defun yahtml-jump-to-error-line (&optional sit)

2910 (interactive "P")

2911 (let ((p (point)) (e (point-end-of-line)))

2912 (end-of-line)

2913 (if (re-search-backward yahtml-error-line-regexp nil t)

2914 (let ((f (if (string= "" (YaTeX-match-string 1))

2915 YaTeX-current-file-name

2916 (YaTeX-match-string 1)))

2917 (l (string-to-int (or (YaTeX-match-string 2)

2918 (YaTeX-match-string 3)))))

2919 (if sit (sit-for 1))

2920 (forward-line -1)

2921 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2922 (goto-line l))

2923 (message "No line number usage"))))

2924

2925 ;;; ---------- Style Sheet Support ----------

2926 (defvar yahtml-css-class-alist nil

2927 "Alist of elements vs. their classes")

2928

2929 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2930 (save-excursion

2931 (save-restriction

2932 (narrow-to-region beg end)

2933 (goto-char (point-min))

2934 (let ((alist initial) b e element class a)

2935 (setq b (point))

2936 (while (re-search-forward "\${\$\\|\$@import\$" nil t)

2937 (if (match-beginning 2)

2938 (let ((f (YaTeX-buffer-substring

2939 (progn (skip-chars-forward "^\"")(1+ (point)))

2940 (progn (forward-char 1)

2941 (skip-chars-forward "^\"")(point)))))

2942 (if (file-exists-p f)

2943 (setq alist

2944 (append alist (yahtml-css-collect-classes-file f)))))

2945 (setq e (point))

2946 (goto-char b)

2947 (while (re-search-forward ;ちょといい加減なREGEXP

2948 "\$[a-z*][-a-z0-9]*\$?\\.\$[-a-z0-9][-a-z0-9]*\$\\>"

2949 e t)

2950 (setq element (YaTeX-match-string 1)

2951 class (YaTeX-match-string 2))

2952 ;;if starts with period (match-string 1 is nil),

2953 ;;this is global class

2954 (setq element (downcase (or element "*")))

2955 (if (setq a (assoc element alist))

2956 (or (assoc class (cdr a))

2957 (setcdr a (cons (list class) (cdr a))))

2958 (setq alist (cons (list element (list class)) alist))))

2959 (goto-char (1- e))

2960 (search-forward "}" nil t)

2961 (setq b (point))))

2962 alist))))

2963

2964 (defun yahtml-css-collect-classes-buffer (&optional initial)

2965 (interactive)

2966 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2967

2968 (defun yahtml-css-collect-classes-file (file &optional initial)

2969 (let*((hilit-auto-highlight nil)

2970 (buf (get-buffer-create

2971 (format " *css-collection*%s" (file-name-nondirectory file))))

2972 (cb (current-buffer)))

2973 (unwind-protect

2974 (progn

2975 (set-buffer buf)

2976 (insert-file-contents file)

2977 (cd (or (file-name-directory file) "."))

2978 (yahtml-css-collect-classes-buffer initial))

2979 (if (eq buf cb)

2980 nil

2981 (kill-buffer buf)

2982 (set-buffer cb)))))

2983

2984 (defun yahtml-css-scan-styles ()

2985 (save-excursion

2986 (goto-char (point-min))

2987 (set (make-local-variable 'yahtml-css-class-alist) nil)

2988 (let (b tag type e href alist)

2989 (while (re-search-forward "<\$style\\|link\$" nil t)

2990 (setq b (match-beginning 0)

2991 tag (YaTeX-match-string 1))

2992 (cond

2993 ((string-match "style" tag)

2994 (goto-char b)

2995 (save-excursion (forward-list 1) (setq e (point)))

2996 (cond

2997 ((search-forward "text/css" e 1) ;css definition starts

2998 (setq alist

2999 (yahtml-css-collect-classes-region

3000 (point) (progn (search-forward "</style>") (point))

3001 alist)))))

3002 ((and (string-match "link" tag)

3003 (stringp (setq type (yahtml-get-attrvalue "type")))

3004 (string-match "text/css" type)

3005 (setq href (yahtml-get-attrvalue "href"))

3006 (file-exists-p (yahtml-url-to-path href)))

3007 (setq alist

3008 (yahtml-css-collect-classes-file

3009 (yahtml-url-to-path href) alist))))

3010 (setq yahtml-css-class-alist alist)))))

3011

3012 (defun yahtml-css-get-element-completion-alist (element)

3013 (let ((alist (cdr-safe (assoc (downcase element) yahtml-css-class-alist)))

3014 (global (cdr-safe (assoc "*" yahtml-css-class-alist))))

3015 (and (or alist global)

3016 (append alist global))))

3017

3018 ;;; ---------- ----------

3019

3020 ;;;

3021 ;;hilit19

3022 ;;;

3023 (defvar yahtml-default-face-table

3024 '(

3025 (form black/ivory white/hex-442233 italic)

3026 ))

3027 (defvar yahtml-hilit-patterns-alist

3028 '(

3029 'case-fold

3030 ;; comments

3031 ("" comment)

3032 ;; include&exec

3033 ("" include)

3034 ;; string

3035 (hilit-string-find ?\\ string)

3036 (yahtml-hilit-region-tag "<\$strong\\|b\$\\>" bold)

3037 ("</?[uod]l>" 0 decl)

3038 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

3039 (yahtml-hilit-region-tag "<\$em\\|i\\>\$" italic)

3040 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

3041 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

3042 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3043 ))

3044

3045 (defun yahtml-hilit-region-tag (tag)

3046 "Return list of start/end point of <TAG> form."

3047 (if (re-search-forward tag nil t)

3048 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

3049 (elm (YaTeX-match-string 1)))

3050 (skip-chars-forward "^>")

3051 (prog1

3052 (cons (1+ (point))

3053 (progn (re-search-forward (concat "</" elm ">") nil t)

3054 (match-beginning 0)))

3055 (goto-char e0)))))

3056

3057 (defun yahtml-hilit-region-tag-itself (ptn)

3058 "Return list of start/end point of <tag options...> itself."

3059 (if (re-search-forward ptn nil t)

3060 (let ((m0 (match-beginning 0)) (e0 (match-end 0)))

3061 (skip-chars-forward "^<>")

3062 (if (eq (char-after (point)) ?<) nil

3063 (prog1

3064 (cons m0 (min (point-max) (1+ (point))))

3065 (goto-char e0))))))

3066

3067 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

3068 (and yahtml-use-hilit19

3069 (or (assq 'yahtml-mode hilit-patterns-alist)

3070 (setq hilit-patterns-alist

3071 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

3072 hilit-patterns-alist))))

3073 ;;;

3074 ;; for font-lock

3075 ;;;

3076

3077 ; <<STATIC KEYWORDS BELOW NOT USED>>

3078 ;(defvar yahtml-font-lock-keywords

3079 ; '(

3080 ; ;; comments

3081 ; ("" . font-lock-comment-face)

3082 ; ;; include&exec

3083 ; (""

3084 ; 0 font-lock-include-face keep)

3085 ; ;; string

3086 ; ;(hilit-string-find ?\\ string)

3087 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

3088 ; ("</?[uod]l>" 0 font-lock-keyword-face)

3089 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

3090 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

3091 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

3092 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

3093 ; )

3094 ; "*Defualt font-lock-keywords for yahtml-mode.")

3095 (defvar yahtml-font-lock-keywords

3096 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

3097 "Default fontifying patterns for yahtml-mode")

3098

3099 (defun yahtml-font-lock-set-default-keywords ()

3100 (put 'yahtml-mode 'font-lock-defaults

3101 '(yahtml-font-lock-keywords nil t)))

3102

3103 (if yahtml-use-font-lock

3104 (progn

3105 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

3106 ;;for those who use both hilit19 and font-lock

3107 (if (eq (car hilit-mode-enable-list) 'not)

3108 (or (member 'yahtml-mode hilit-mode-enable-list)

3109 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

3110 (setq hilit-mode-enable-list

3111 (delq 'yahtml-mode hilit-mode-enable-list))))

3112 (yahtml-font-lock-set-default-keywords)))

3113

3114 (defun yahtml-font-lock-recenter (&optional arg)

3115 (interactive "P")

3116 (font-lock-mode -1) ;is stupid, but sure.

3117 (font-lock-mode 1))

3118

3119 (run-hooks 'yahtml-load-hook)

3120 (provide 'yahtml)

3121

3122 ; Local variables:

3123 ; fill-prefix: ";;; "

3124 ; paragraph-start: "^$\\|\\|;;;$"

3125 ; paragraph-separate: "^$\\|\\|;;;$"

3126 ; coding: sjis

3127 ; End: