yatex: 0aaebd07dad0 yahtml.el

yatex

view yahtml.el @ 72:0aaebd07dad0

Support font-lock on XEmacs-21, Emacs-20, Emacs-21. Support Emacs-21.

author	yuuji
date	Mon, 25 Dec 2000 10:19:28 +0000
parents	44e3a5e1e883
children	f41b01fef5d6

line source

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

2 ;;; (c ) 1994-2000 by HIROSE Yuuji [yuuji@yatex.org]

3 ;;; Last modified Mon Dec 25 18:56:49 2000 on firestorm

4 ;;; $Id$

6 (defconst yahtml-revision-number "1.69"

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 "netscape")

18 ;;; ;Write your favorite browser. But netscape 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 "netscape")

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

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 ;;;[Commentary]

41 ;;;

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

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

44 ;;;

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

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

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

48 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

73 ;;; change the reference link with completion.

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

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

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

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

78 ;;; is "netscape")

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

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

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

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

83 ;;; in the region.

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

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

86 ;;; URLencoded string in the region.

87 ;;;

88 ;;;[キーの説明]

89 ;;;

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

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

92 ;;;

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

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

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

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

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

98 ;;; できます。

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

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

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

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

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

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

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

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

107 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

119 ;;; す。

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

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

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

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

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

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

126 ;;; きます。

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

128 ;;; す。

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

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

131 ;;; く。お推めは "netscape" で、ねすけの場合既にねす

132 ;;; けが起動されていた場合そのねすけに Reload 命令を

133 ;;; 送るという芸当が出来ます)

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

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

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

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

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

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

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

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

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

143 ;;;

144 ;;; [謝辞]

145 ;;;

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

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

148 ;;;

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

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

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

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

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

154 ;;;

155

156

157 ;(require 'yatex)

158 (require 'yatexlib)

159 ;;; --- customizable variable starts here ---

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

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

162 (defvar yahtml-image-viewer "xv" "*Image viewer program")

163 (defvar yahtml-www-browser "netscape"

164 "*WWW Browser command")

165 (defvar yahtml-kanji-code 2

166 "*Kanji coding system number of html file; 1=sjis, 2=jis, 3=euc")

167 ;;(defvar yahtml-coding-system

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

169 ;; "Kanji coding system")

170 (and (featurep 'mule)

171 (integerp yahtml-kanji-code)

172 (setq yahtml-kanji-code

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

174

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

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

177

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

179 (defvar yahtml-path-url-alist nil

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

181 Ex.

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

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

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

185 "*Directory index file name;

186 Consult your site's WWW administrator.")

187

188 (defvar yahtml-environment-indent 1

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

190

191 (defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)

192 "Whether yatex mode is running on Japanese environment or not.")

193

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

195 "*Program name to lint HTML file")

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

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

198

199 (defvar yahtml-always-/p nil

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

201

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

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

204

205 (defvar yahtml-template-file "~/http/template.html"

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

207

208 (defvar yahtml-prefer-upcases nil

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

210

211 (defvar yahtml-prefer-upcase-attributes nil

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

213

214 (defvar yahtml-server-type 'apache

215 "*WWW server program type")

216

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

218 "*Server access file name for apache")

219

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

221

222 (defvar yahtml-image-inspection-bytes 10000 ;256

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

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

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

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

227 %f: filename")

228

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

230 (defvar yahtml-error-line-regexp

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

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

233

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

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

236 (defvar yahtml-escape-chars 'ask

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

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

239 at each reserved chars.")

240

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

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

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

244

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

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

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

248

249 ;;; --- customizable variable ends here ---

250 (defvar yahtml-prefix-map nil)

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

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

253 (defvar yahtml-shell-command-option

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

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

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

257

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

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

260 (YaTeX-define-key

261 key

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

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

264 map))

265

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

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

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

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

270

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

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

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

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

275 (if YaTeX-inhibit-prefix-letter nil

276 (yahtml-define-begend-region-key

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

278

279 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

291 (let ((map yahtml-prefix-map))

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

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

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

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

296 (and YaTeX-emacs-19 window-system

297 (progn

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

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

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

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

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

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

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

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

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

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

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

309 (if YaTeX-no-begend-shortcut

310 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

329 )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

344 )

345 (substitute-all-key-definition

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

347 (substitute-all-key-definition

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

349

350 (if yahtml-lint-buffer-map nil

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

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

353

354

355 (defvar yahtml-paragraph-start

356 (concat

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

358 "*Regexp of html paragraph separater")

359 (defvar yahtml-paragraph-separate

360 (concat

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

362 "*Regexp of html paragraph separater")

363 (defvar yahtml-syntax-table nil

364 "*Syntax table for yahtml-mode")

365

366 (if yahtml-syntax-table nil

367 (setq yahtml-syntax-table

368 (make-syntax-table (standard-syntax-table)))

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

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

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

372 )

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

374 "Regexp of constituent of html commands.")

375

376 ;;; Completion tables for `form'

377 (defvar yahtml-form-table

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

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

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

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

382

383 (defvar yahtml-env-table

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

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

386 ("OrderedList" . "ol")

387 ("UnorderedList" . "ul")

388 ("DefinitionList" . "dl")

389 ("Preformatted" . "pre")

390 ("table") ("thead") ("tbody") ("tfoot") ("caption") ("tr") ("th") ("td")

391 ("address")

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

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

394 ("style") ("div") ("object")

395 ))

396

397 ;(defvar yahtml-itemizing-regexp

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

399 ; "Regexp of itemizing forms")

400

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

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

403

404 ;;; Completion tables for typeface designator

405 (and yahtml-always-/p

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

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

408

409 (defvar yahtml-typeface-table

410 (append

411 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("strike") ("s")

412 ("strong") ("var") ("b") ("i") ("tt") ("u") ("big") ("small") ("font")

413 ("sup") ("sub") ("span"))

414 yahtml-env-table)

415 "Default completion table of typeface designator")

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

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

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

419

420 (defvar yahtml-single-cmd-table

421 '(("hr") ("br") ("option") ("p")

422 ("HorizontalLine" . "hr")

423 ("BreakLine" . "br")

424 ("Paragraph" . "p")

425 ("Item" . "li")

426 ("DefineTerm" . "dt")

427 ("Description" . "dd")

428 ("dd") ("dt") ("li")

429 )

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

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

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

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

434

435 (defvar yahtml-current-completion-type nil

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

437

438 ;(defvar yahtml-struct-name-regexp

440 (defvar yahtml-struct-name-regexp

441 (concat

442 "\\<\\("

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

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

445 "\\)\\b")

446 "Regexp of structure beginning.")

447

448 (defvar yahtml-closable-regexp

449 (concat

450 "\\<\\("

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

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

453 "\\)\\b")

454 "Regexp of any closable elemnts.")

455

456

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

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

459

460

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

462 (cond

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

464 buffer-file-name)

465 (let ((dir default-directory)

466 charset af ext (ldir "")

467 line

468 (case-fold-search t)

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

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

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

472 (while (and dir

473 (not (string= dir ldir))

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

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

476 (if (file-exists-p af)

477 (save-excursion

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

479 (save-excursion

480 (goto-char (point-min))

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

482 (setq line (buffer-substring

483 (point-beginning-of-line)

484 (point-end-of-line))

485 dir nil)))

486 (kill-buffer (current-buffer))))

487 (if dir

488 (setq ldir dir

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

490 dir (file-name-directory dir))))

491 line

492 ))

493 (t nil))

494 )

495

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

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

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

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

500 line

501 charset)

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

503 (progn

504 (string-match ptn line)

505 (setq charset

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

507 (cond

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

509 (setq charset 2))

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

511 (setq charset 3))

512 ((string-match "shift_jis" charset)

513 (setq charset 1))

514 (t (setq charset nil)))

515 (setq dir "")))

516 (if (featurep 'mule)

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

518 charset))

519

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

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

522 x index-list)

523 ;;s/\\s *$//;

524 (if line

525 (progn

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

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

528 (while (string< "" line)

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

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

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

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

533 line ""))

534 )

535 (or (nreverse index-list)

536 (if (listp yahtml-directory-index)

537 yahtml-directory-index

538 (list yahtml-directory-index)))))))

539

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

541 (defun yahtml-mode ()

542 (interactive)

543 (kill-all-local-variables)

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

545 (cond

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

547 (setq buffer-file-coding-system

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

549 (save-excursion (set-auto-coding buffer-file-name 2000)))

550 coding)))

551 ((featurep 'mule)

552 (set-file-coding-system coding))

553 ((boundp 'NEMACS)

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

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

556 (if (not (eq 'yahtml-mode major-mode))

557 (set (make-local-variable 'yahtml-mode-old-mode) major-mode))

558 (setq major-mode 'yahtml-mode

559 mode-name "yahtml"

560 YaTeX-current-file-name (file-name-nondirectory (buffer-file-name)))

561 (mapcar

562 (function (lambda (x)

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

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

565 (boundp (cdr x)))

566 (symbol-value (cdr x))

567 (cdr x)))))

568 '((YaTeX-ec . "")

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

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

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

572 (YaTeX-comment-prefix . "<!--")

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

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

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

576 (paragraph-start . yahtml-paragraph-start)

577 (paragraph-separate . yahtml-paragraph-separate)

578 (comment-start . "")

579 (comment-start-skip . comment-start)

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

581

582 (if yahtml-use-font-lock

583 (progn

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

585 (or (featurep 'xemacs)

586 (progn

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

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

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

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

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

592 (font-lock-fontify-buffer)

593 ))

594 ))

595 (set-syntax-table yahtml-syntax-table)

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

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

598 (yahtml-css-scan-styles)

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

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

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

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

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

604

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

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

607 font-lock-defaults)

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

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

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

611

612 (defun yahtml-version ()

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

614 (interactive)

615 (message

616 (concat "Yet Another HTML-mode "

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

618 " Revision "

619 yahtml-revision-number)))

620

621 (defun yahtml-quit ()

622 (interactive)

623 (and yahtml-mode-old-mode

624 (fboundp yahtml-mode-old-mode)

625 (funcall yahtml-mode-old-mode)))

626

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

628 (cond

629 ((featurep 'xemacs)

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

631 (set keymap nil)

632 (mapcar

633 (function

634 (lambda (bind)

635 (setq bind (cdr bind))

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

637 (setcar (cdr bind) 'progn))

638 (if (stringp (car (cdr bind)))

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

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

641 (symbol-value keymap))))))

642 bindlist)

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

644 (t

645 (mapcar

646 (function

647 (lambda (bind)

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

649 bindlist))))

650

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

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

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

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

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

656

657 ;;; Variables for mosaic url history

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

659 (defvar yahtml-urls-private nil)

660 (defvar yahtml-urls-local nil)

661

662 (cond

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

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

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

666 (YaTeX-define-menu

667 'yahtml-menu-map-sectioning

668 (nreverse

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

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

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

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

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

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

675 )))

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

677 (YaTeX-define-menu

678 'yahtml-menu-map-logical

679 (nreverse

680 '((em "Embolden" .

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

682 (dfn "Define a word" .

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

684 (cite "Citation" .

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

686 (code "Code" .

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

688 (kbd "Keyboard" .

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

690 (samp "Sample display" .

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

692 (strong "Strong" .

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

694 (VAR "Variable notation" .

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

696 )))

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

698 (YaTeX-define-menu

699 'yahtml-menu-map-typeface

700 (nreverse

701 '((b "Bold" .

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

703 (i "Italic" .

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

705 (tt "Typewriter" .

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

707 (u "Underlined" .

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

709 )))

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

711 (YaTeX-define-menu

712 'yahtml-menu-map-listing

713 (nreverse

714 '((ul "Unordered" .

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

716 (ol "Ordered" .

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

718 (dl "Definition" .

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

720 )))

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

722 (YaTeX-define-menu

723 'yahtml-menu-map-item

724 (nreverse

725 '((li "Simple item" .

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

727 (dt "Define term" .

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

729 (dd "Description of term" .

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

731 )))

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

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

734 (YaTeX-define-menu

735 'yahtml-menu-map

736 (nreverse

737 (list

738 (cons (list 'sect "Sectioning")

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

740 (cons (list 'list "Listing")

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

742 (cons (list 'item "Item")

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

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

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

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

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

748 )))

749 (if (featurep 'xemacs)

750 (add-hook 'yahtml-mode-hook

751 '(lambda ()

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

753 (progn

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

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

756 ))

757

758 ;;; ----------- Completion ----------

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

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

761 "Insert <cmd> ... </cmd>."

762 (interactive "P")

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

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

765 (cmd

766 (or env

767 (YaTeX-cplread-with-learning

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

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

770 (bolp (save-excursion

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

772 (cc (current-column)))

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

774 (setq yahtml-last-begend

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

776 yahtml-last-begend))

777 (setq cmd yahtml-last-begend)

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

779 (if region

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

781 ;; to enable continuous regioning by another environment

782 (let ((beg (region-beginning))

783 (end (region-end))

784 (addin (yahtml-addin cmd)))

785 (save-excursion

786 (goto-char end)

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

788 (goto-char beg)

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

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

791 (save-excursion

792 (insert "\n")

793 (indent-to-column cc)

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

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

796 (newline)

797 (yahtml-intelligent-newline nil))

798 (yahtml-indent-line))))

799

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

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

802 (interactive)

803 (yahtml-insert-begend t))

804

805

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

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

808 (interactive)

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

810 (or form

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

812 (setq form

813 (YaTeX-cplread-with-learning

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

815 'yahtml-form-table 'yahtml-user-form-table

816 'yahtml-tmp-form-table))))

817 (let ((p (point)) q)

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

819 (setq yahtml-last-form form)

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

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

822 ;;(indent-relative-maybe)

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

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

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

826

827 ;;; ---------- Add-in ----------

828 (defun yahtml-addin (form)

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

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

831 (concat

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

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

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

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

836 "class" (completing-read "class: " a)))

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

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

839 (string< "" s))

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

841 ""))))

842

843

844 (defvar yahtml-completing-buffer nil)

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

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

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

848 (let (list end)

849 (save-excursion

850 (set-buffer yahtml-completing-buffer)

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

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

853 (save-excursion

854 (goto-char (point-min))

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

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

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

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

859 (setq end (match-end 0))

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

861 (yahtml-on-assignment-p)

862 (progn

863 (goto-char end)

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

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

866 (setq list (cons

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

868 list))))

869 list)))

870 )

871

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

873 (if yahtml-url-completion-map nil

874 (setq yahtml-url-completion-map

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

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

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

878 )

879

880 (defun yahtml-complete-url ()

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

882 (interactive)

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

884 (lim (YaTeX-minibuffer-begin)))

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

886 (cond

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

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

889 listfunc (list 'lambda nil

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

891 beg (point-min)))

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

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

894 (progn

895 (setq path (substring initial 0 beg))

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

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

898 (setq initial (substring initial beg))

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

900 cmpl (try-completion initial labels)

901 listfunc (list 'lambda ()

902 (list 'all-completions

903 initial (list 'quote labels)))

904 beg (+ (point-min) beg)))

905 (t

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

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

908 initial))

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

910 file (file-name-nondirectory path)

911 initial file

912 cmpl (file-name-completion file dir)

913 listfunc (list 'lambda nil

914 (list 'file-name-all-completions

915 file dir))

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

917 (cond

918 ((stringp cmpl)

919 (if (string= initial cmpl)

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

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

922 (princ

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

924 (delete-region (point) beg)

925 (insert cmpl)))

926 ((null cmpl)

927 (ding))

928 ((eq t cmpl)

929 (save-excursion

930 (unwind-protect

931 (progn

932 (goto-char p)

933 (insert " [Sole completion]"))

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

935

936 ;

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

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

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

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

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

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

943 ;

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

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

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

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

948 (defvar yahtml-unsafe-chars-regexp

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

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

951 ;

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

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

954 ;

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

956 ; "$" | ","

957 (defvar yahtml-unreserved-chars-regexp

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

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

960 Not used yet.")

961

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

963 "Translate reserved chars to URL encoded string."

964 (let ((p 0) (target "")

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

966 (cond

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

968 (t

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

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

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

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

973 (setq target (concat target

974 (substring str 0 p)

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

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

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

978 (concat target str)))))

979

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

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

982 (interactive "r")

983 (save-excursion

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

985 (goto-char beg)

986 (while (and (< (point) e)

987 (re-search-forward

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

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

990 (sit-for 0)

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

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

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

994 ; (unwind-protect

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

996 ; (save-excursion

997 ; (backward-char 1)

998 ; (delete-backward-char 4))

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

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

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

1002 (progn

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

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

1005 (set-marker e nil))))

1006 ;; ab%defgls/.|

1007

1008 (defun yahtml:a ()

1009 "Add-in function for <a>"

1010 (let ((href ""))

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

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

1013 href (yahtml-escape-chars-string

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

1015 (prog1

1016 (concat (yahtml-make-optional-argument

1017 "href" href)

1018 (yahtml-make-optional-argument

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

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

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

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

1023 (YaTeX-update-table

1024 (list href)

1025 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

1026 )))

1027

1028 (defvar yahtml-parameters-completion-alist

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

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

1031 ("src" . file)

1032 ("background" . file)

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

1034 ("method" ("POST") ("GET"))

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

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

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

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

1039

1040 (defvar yahtml-link-types-alist

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

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

1043 ("subsection") ("appendix") ("help") ("bookmark")))

1044

1045 (defvar yahtml-content-types-alist

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

1047 ("text/sgml") ("text/xml")

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

1049 ("application/java")

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

1051 "Alist of content-types")

1052

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

1054 (let* ((alist

1055 (cdr-safe (assoc (downcase par)

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

1057 (prompt (concat par ": "))

1058 v)

1059 (cond

1060 ((eq alist 'file)

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

1062 ((and alist (symbolp alist))

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

1064 (alist

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

1066 (t

1067 (read-string prompt default)))))

1068

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

1070 "Make optional argument string."

1071 (if (string= "" arg)

1072 ""

1073 (concat " "

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

1075 "=\"" arg "\"")))

1076

1077 (defun yahtml:body ()

1078 "Add-in function for <body>"

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

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

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

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

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

1084 (concat

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

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

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

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

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

1090

1091 (defun yahtml:img ()

1092 "Add-in function for <img>"

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

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

1095 alt

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

1097 (l yahtml-prefer-upcase-attributes)

1098 info width height bytes comments)

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

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

1101 (car info)

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

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

1104 bytes (car (cdr (cdr info)))

1105 comments (nth 4 info)))

1106 (if info

1107 (setq alt

1108 (YaTeX-replace-formats

1109 yahtml:img-default-alt-format

1110 (list (cons "x" width)

1111 (cons "y" height)

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

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

1114 (cons "c" (car comments))))))

1115

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

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

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

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

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

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

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

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

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

1125

1126 (defun yahtml-file-truename (file)

1127 (cond

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

1129 (t (let ((new file))

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

1131 (not (equal new file)))

1132 (setq file new))

1133 file))))

1134

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

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

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

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

1139 (let ((mlt 1)

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

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

1142 (value 0))

1143 (while (> length 0)

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

1145 pos (+ pos direc)

1146 mlt (* mlt 256)

1147 length (1- length)))

1148 value))

1149

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

1151 "Return the information on the image file FILE.

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

1153 (save-excursion

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

1155 width height bytes depth comment

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

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

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

1159 (seekpoint 1)

1160 c1 c2 c3 c4 beg end

1161 (case-fold-search nil))

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

1163 (set-buffer tmpbuf)

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

1165 (erase-buffer)

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

1167 (unwind-protect

1168 (progn

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

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

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

1172 (YaTeX-insert-file-contents

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

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

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

1176 c2 (char-after 2)

1177 c3 (char-after 3)

1178 c4 (char-after 4))

1179 (cond

1180 ((and (eq c1 255) (eq c2 216)) ; 0xff 0xd8

1181 ;;JPEG images need JPEG markers inspection

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

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

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

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

1186 (catch 'exit

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

1188 (cond

1189 ((not (eq (char-after seekpoint) 255))

1190 ;maybe corrupted, exit from loop

1191 (throw 'exit t))

1192 ((memq (char-after (1+ seekpoint))

1193 '(192 193 194 195 197 198 199 201 202 203 205 206 207))

1194 ;;found!

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

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

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

1198 ((eq (char-after (1+ seekpoint)) 254) ;0xFE = comment

1199 ;; JPEG comment area

1200 (setq beg (+ seekpoint 2 2)

1201 end (+ seekpoint

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

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

1204 (t ;other markers

1205 nil)) ;just skip it

1206 (setq seekpoint (+ seekpoint 2)

1207 seekpoint (+ seekpoint

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

1209 ((and (eq c1 137) ;0x89

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

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

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

1213 height (yahtml-hex-value 20 4)

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

1215 ((looking-at "GIF8")

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

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

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

1219 ((looking-at "BM")

1220 ;;# OS/2, Windoze BMP files

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

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

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

1224 (cond

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

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

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

1228 (t

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

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

1231 ))

1232 (message "")

1233 (kill-buffer tmpbuf))

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

1235

1236 (defun yahtml:form ()

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

1238 (concat

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

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

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

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

1243 ))

1244

1245 (defun yahtml:select ()

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

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

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

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

1250

1251 (defun yahtml:ol ()

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

1253 (defun yahtml:ul ()

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

1255 (defun yahtml:dl ()

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

1257 (defun yahtml:dt ()

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

1259

1260 (defun yahtml:p ()

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

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

1263 ))

1264

1265 (defvar yahtml-input-types

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

1267 ("reset") ("image") ("hidden") ("file")))

1268

1269 (defun yahtml:input ()

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

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

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

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

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

1275 yahtml-input-types nil t)

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

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

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

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

1280 (concat

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

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

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

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

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

1286 )))

1287

1288 (defun yahtml:textarea ()

1289 "Add-in function for `textarea'"

1290 (interactive)

1291 (let (name rows cols)

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

1293 cols (read-string "Columns: ")

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

1295 (concat

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

1297 "\"" name "\"")

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

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

1300

1301 (defun yahtml:table ()

1302 "Add-in function for `table'"

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

1304 (a (yahtml-read-parameter "align")))

1305 (concat

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

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

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

1309 (defun yahtml:caption ()

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

1311 (let ((yahtml-parameters-completion-alist '(("align" ("top") ("bottom")))))

1312 (yahtml-make-optional-argument "align" (yahtml-read-parameter "align"))))

1313

1314 (defun yahtml:font ()

1315 "Add-in function for `font'"

1316 (concat

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

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

1319

1320 (defun yahtml:style ()

1321 "Add-in function for `style'"

1322 (yahtml-make-optional-argument

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

1324

1325 (defun yahtml:tr ()

1326 "Add-in function for `tr'"

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

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

1329 "")

1330

1331 (defun yahtml:link ()

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

1333 (let (rel rev type href)

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

1335 (cond

1336 ((equal rel "")

1337 (concat (yahtml-make-optional-argument

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

1339 (yahtml-make-optional-argument

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

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

1342 )))

1343 ((string-match "stylesheet" rel)

1344 (concat

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

1346 (yahtml-make-optional-argument

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

1348 (progn

1349 (setq href

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

1351 (if (string< "" href)

1352 (progn

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

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

1355 (setq yahtml-css-class-alist

1356 (yahtml-css-collect-classes-file

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

1358 (message "")

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

1360 (t ;;??

1361 ))))

1362

1363 (defun yahtml:br ()

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

1365

1366 (defun yahtml:object ()

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

1368 data classid)

1369 (cond

1370 ((string-match "java" codetype)

1371 (let ((completion-ignored-extensions

1372 ;;any extensions except ".class"

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

1374 (setq classid (concat "java:"

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

1376 (concat

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

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

1379 (yahtml-make-optional-argument

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

1381 (yahtml-make-optional-argument

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

1383 (yahtml-make-optional-argument

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

1385 ))

1386 (t

1387 ""

1388 ))))

1389

1390 ;;; ---------- Simple tag ----------

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

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

1393 (interactive "P")

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

1395 (or tag

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

1397 (setq tag

1398 (YaTeX-cplread-with-learning

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

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

1401 'yahtml-typeface-table 'yahtml-user-typeface-table

1402 'yahtml-tmp-typeface-table))))

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

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

1405 (setq yahtml-last-typeface-cmd tag

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

1407 (if region-mode

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

1409 (save-excursion

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

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

1412 (exchange-point-and-mark)

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

1414 (message "No mark set now"))

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

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

1417

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

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

1420 (interactive)

1421 (yahtml-insert-tag t tag))

1422

1423

1424 (defun yahtml-insert-single (cmd)

1425 "Insert <CMD>."

1426 (interactive

1427 (list

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

1429 (YaTeX-cplread-with-learning

1430 (format "Command%s: "

1431 (if yahtml-last-single-cmd

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

1433 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1436 (setq yahtml-last-single-cmd

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

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

1439 yahtml-last-single-cmd))

1440 (insert (format "<%s>" cmd)))

1441

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

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

1444 (interactive "P")

1445 (if arg (yahtml-insert-tag nil "p")

1446 (save-excursion ;insert "/p" first to memorize "p"

1447 (yahtml-insert-single "/p")) ;in the last-completion variable

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

1449

1450 (defun yahtml-insert-amps (arg)

1451 "Insert char-entity references via ampersand"

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

1453 (interactive "P")

1454 (let*((mess "") c

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

1456 yahtml-entity-reference-chars-alist))

1457 (l list))

1458 (while l

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

1460 l (cdr l)))

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

1462 (setq c (read-char))

1463 (cond

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

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

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

1467 (insert "&;")

1468 (forward-char -1))

1469 ((equal c ? )

1470 (insert ?&))

1471 (t (insert (format "&#%d;" c))))))

1472

1473 ;;; ---------- Jump ----------

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

1475 "Check if point is on href clause."

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

1477 (save-excursion

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

1479 (save-excursion

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

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

1482 (setq e (point)))

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

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

1485 (search-forward "href" e t)

1486 (search-forward "=" e t)

1487 (progn

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

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

1490 (< p (match-end 0))

1491 (YaTeX-match-string 1)

1492 ))))

1493

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

1495 (cond

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

1497 (set-process-buffer proc nil))

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

1499 (let ((cb (current-buffer)))

1500 (set-buffer (process-buffer proc))

1501 (goto-char (point-min))

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

1503 (progn

1504 (message "Starting netscape...")

1505 (start-process

1506 "browser" (process-buffer proc)

1507 shell-file-name yahtml-shell-command-option

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

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

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

1511 (set-buffer cb)))))

1512

1513 (defvar yahtml-browser-process nil)

1514

1515 (defun yahtml-browse-html (href)

1516 "Call WWW Browser to see HREF."

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

1518 (cond

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

1520 (if (get-buffer pb)

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

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

1523 (set-process-sentinel

1524 (setq yahtml-browser-process

1525 (start-process

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

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

1528 'yahtml-netscape-sentinel))

1529 ((and (string-match "[Nn]etscape" yahtml-www-browser)

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

1531 (if (get-buffer pb)

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

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

1534 (set-process-sentinel

1535 (setq yahtml-browser-process

1536 (start-process

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

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

1539 'yahtml-netscape-sentinel))

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

1541 (w3-fetch href))

1542 ((stringp yahtml-www-browser)

1543 (if (and yahtml-browser-process

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

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

1546 (setq yahtml-browser-process

1547 (start-process

1548 "browser" "* WWW Browser *"

1549 shell-file-name yahtml-shell-command-option

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

1551 (t

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

1553

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

1555 "Go to corresponding name."

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

1557 (if href

1558 (cond

1559 ((string-match "^\$ht\\|f\$tp:" href)

1560 (yahtml-browse-html href))

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

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

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

1564 (if (string< "" file)

1565 (progn

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

1567 (or (catch 'dirindex

1568 (mapcar

1569 (function

1570 (lambda (f)

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

1572 (throw 'dirindex

1573 (setq file (concat file f))))))

1574 (yahtml-get-directory-index)))

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

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

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

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

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

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

1581 (if name

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

1583 t)))))

1584

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

1586 "Jump to html's named tag."

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

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

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

1590 (message "Named tag `%s' not found" (substring href 1))))

1591

1592 (defun yahtml-on-begend-p (&optional p)

1593 "Check if point is on begend clause."

1594 (let ((p (or p (point))) cmd (case-fold-search t))

1595 (save-excursion

1596 (goto-char p)

1597 (if (equal (char-after (point)) ?<) (forward-char 1))

1598 (if (and (re-search-backward "<" nil t)

1599 (looking-at

1600 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1601 "<\$/?[A-Z][A-Z0-9]*\$\\b"

1602 )

1603 (condition-case nil

1604 (forward-list 1)

1605 (error nil))

1606 (< p (point)))

1607 (YaTeX-match-string 1)))))

1608

1609 (defun yahtml-goto-corresponding-begend (&optional noerr)

1610 "Go to corresponding opening/closing tag.

1611 Optional argument NOERR causes no error for unballanced tag."

1612 (let ((cmd (yahtml-on-begend-p)) m0

1613 (p (point)) (case-fold-search t) func str (nest 0))

1614 (cond

1615 (cmd

1616 (setq m0 (match-beginning 0))

1617 (if (= (aref cmd 0) ?/) ;on </cmd> line

1618 (setq cmd (substring cmd 1)

1619 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1620 func 're-search-backward)

1621 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1622 func 're-search-forward))

1623 (while (and (>= nest 0) (funcall func str nil t))

1624 (if (equal m0 (match-beginning 0))

1625 nil

1626 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1627 (if (< nest 0)

1628 (goto-char (match-beginning 0))

1629 (funcall

1630 (if noerr 'message 'error)

1631 "Corresponding tag of `%s' not found." cmd)

1632 (goto-char p)

1633 nil))

1634 (t nil))))

1635

1636 (defun yahtml-current-tag ()

1637 "Return the current tag name."

1638 (save-excursion

1639 (let ((p (point)) b tag)

1640 (or (bobp)

1641 (looking-at "<")

1642 (progn (skip-chars-backward "^<") (forward-char -1)))

1643 (setq b (point))

1644 (skip-chars-forward "<")

1645 (setq tag (buffer-substring

1646 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1647 (goto-char b)

1648 (forward-list 1)

1649 (and (< p (point)) tag))))

1650

1651

1652 (defun yahtml-goto-corresponding-img ()

1653 "View image on point"

1654 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1655 (if (and tag

1656 (string-match "img" tag)

1657 (save-excursion

1658 (re-search-backward "<\\s *img" nil t)

1659 (re-search-forward "src=\"?\$[^\"> ]+\$\"?")

1660 (match-beginning 1)

1661 (setq image

1662 (buffer-substring (match-beginning 1) (match-end 1)))))

1663 (progn

1664 (message "Invoking %s %s..." yahtml-image-viewer image)

1665 (start-process

1666 "Viewer" " * Image Viewer *"

1667 shell-file-name yahtml-shell-command-option ;"-c"

1668 (concat yahtml-image-viewer " " image))

1669 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1670

1671 (defun yahtml-get-attrvalue (attr)

1672 "Extract current tag's attribute value from buffer."

1673 (let (e (case-fold-search t))

1674 (save-excursion

1675 (or (looking-at "<")

1676 (progn (skip-chars-backward "^<") (backward-char 1)))

1677 (setq e (save-excursion (forward-list 1) (point)))

1678 (if (and

1679 (re-search-forward (concat "\\b" attr "\\b") e t)

1680 (progn (skip-chars-forward " \t\n=")

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

1682 (YaTeX-match-string 1)))))

1683

1684 (defun yahtml-goto-corresponding-source (&optional other)

1685 "Goto applet's source."

1686 (let ((env (yahtml-current-tag)) s (p (point)))

1687 (cond

1688 ((string-match "applet" env)

1689 (if (setq s (yahtml-get-attrvalue "code"))

1690 (progn

1691 (setq s (YaTeX-match-string 1)

1692 s (concat

1693 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1694 ".java"))

1695 (if other (YaTeX-switch-to-buffer-other-window s)

1696 (YaTeX-switch-to-buffer s))

1697 s) ;return source file name

1698 (message "No applet source specified")

1699 (sit-for 1)

1700 nil))

1701 ((string-match "!--#include" env)

1702 (cond

1703 ((setq s (yahtml-get-attrvalue "file")) ;

1704 (if other (YaTeX-switch-to-buffer-other-window s)

1705 (YaTeX-switch-to-buffer s))

1706 s)

1707 ((setq s (yahtml-get-attrvalue "virtual"));

1708 (setq s (yahtml-url-to-path s))

1709 (if other (YaTeX-switch-to-buffer-other-window s)

1710 (YaTeX-switch-to-buffer s))

1711 s)))

1712 ((and (string-match "!--#exec" env)

1713 (setq s (yahtml-get-attrvalue "cmd")))

1714 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1715 (let ((b " *yahtmltmp*")) ;peek a little

1716 (unwind-protect

1717 (progn

1718 (set-buffer (get-buffer-create b))

1719 (YaTeX-insert-file-contents s nil 0 100)

1720 (if (looking-at "#!")

1721 (if other (YaTeX-switch-to-buffer-other-window s)

1722 (YaTeX-switch-to-buffer s))))

1723 (kill-buffer (get-buffer b)))

1724 (get-file-buffer s))))))

1725

1726 (defun yahtml-goto-corresponding-* (&optional other)

1727 "Go to corresponding object."

1728 (interactive)

1729 (cond

1730 ((yahtml-goto-corresponding-href other))

1731 ((yahtml-goto-corresponding-img))

1732 ((yahtml-goto-corresponding-begend))

1733 ((yahtml-goto-corresponding-source other))

1734 (t (message "I don't know where to go."))

1735 ))

1736

1737 (defun yahtml-goto-corresponding-*-other-window ()

1738 "Go to corresponding object."

1739 (interactive)

1740 (yahtml-goto-corresponding-* t))

1741

1742 (defun yahtml-visit-main ()

1743 "Go to parent file from where you visit current file."

1744 (interactive)

1745 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1746

1747 ;;; ---------- killing ----------

1748 (defun yahtml-kill-begend (&optional whole)

1749 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1750 (if tag

1751 (save-excursion

1752 (or (looking-at "<")

1753 (progn (skip-chars-backward "^<") (forward-char -1)))

1754 (setq p (point))

1755 (yahtml-goto-corresponding-begend)

1756 (or (looking-at "<")

1757 (progn (skip-chars-backward "^<") (forward-char -1)))

1758 (if (< (point) p) ;if on the opening tag

1759 (progn (setq q p p (point))

1760 (goto-char q))

1761 (setq q (point))) ;now q has end-line's (point)

1762 (if (not whole)

1763 (kill-region

1764 (progn (skip-chars-backward " \t")

1765 (if (setq bbolp (bolp)) (point) q))

1766 (progn (forward-list 1)

1767 (setq r (point))

1768 (skip-chars-forward " \t")

1769 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1770 (goto-char p)

1771 (skip-chars-backward " \t")

1772 (if (not whole)

1773 (progn

1774 (kill-append

1775 (buffer-substring

1776 (setq p (if (setq bbolp (bolp)) (point) p))

1777 (setq q (progn

1778 (forward-list 1)

1779 (setq r (point))

1780 (skip-chars-forward " \t")

1781 (if (and bbolp (eolp) (not (eobp)))

1782 (1+ (point))

1783 r))))

1784 t)

1785 (delete-region p q))

1786 (kill-region

1787 (if (bolp) (point) p)

1788 (progn (goto-char q)

1789 (forward-list 1)

1790 (setq r (point))

1791 (skip-chars-forward " \t")

1792 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1793 tag))))

1794

1795 (defun yahtml-kill-* (whole)

1796 "Kill current position's HTML tag (set)."

1797 (interactive "P")

1798 (cond

1799 ((yahtml-kill-begend whole))

1800 ))

1801

1802

1803 ;;; ---------- changing ----------

1804 (defun yahtml-on-assignment-p ()

1805 "Return if current point is on parameter assignment.

1806 If so, return parameter name, otherwise nil.

1807 This function should be able to treat white spaces in value, but not yet."

1808 (let ((p (point)))

1809 (save-excursion

1810 (put 'yahtml-on-assignment-p 'region nil)

1811 (skip-chars-backward "^ \t\n")

1812 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

1813 (< p (match-end 0))

1814 (>= p (1- (match-beginning 2)))

1815 (put 'yahtml-on-assignment-p 'region

1816 (cons (match-beginning 2) (match-end 2)))

1817 (YaTeX-match-string 1)))))

1818

1819 (defun yahtml-change-begend ()

1820 (let ((tag (yahtml-on-begend-p))

1821 (completion-ignore-case t)

1822 (case-fold-search t)

1823 (p (point)) (q (make-marker))

1824 (default (append yahtml-env-table yahtml-typeface-table))

1825 (user (append yahtml-user-env-table yahtml-user-typeface-table))

1826 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

1827 href b1 e1 attr new css)

1828 (cond

1829 (tag

1830 (cond

1831 ((and (string-match "^a$" tag)

1832 (save-excursion

1833 (and

1834 (re-search-backward "<a\\b" nil t)

1835 (progn

1836 (goto-char (match-end 0))

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

1838 (setq b1 (point))

1839 (search-forward ">" nil t))

1840 (setq e1 (match-beginning 0))

1841 (goto-char b1)

1842 (re-search-forward "href\\s *=" e1 t)

1843 (>= p (point))

1844 (progn

1845 (goto-char (match-end 0))

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

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

1848 (< p (match-end 0)))))

1849 (setq b1 (match-beginning 1) e1 (match-end 1)

1850 yahtml-completing-buffer (current-buffer)

1851 ;; yahtml-urls-local is buffer-local, so we must put

1852 ;; that into yahtml-urls here

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

1854 href (read-from-minibuffer

1855 "Change href to: " "" yahtml-url-completion-map))

1856 (if (string< "" href)

1857 (progn

1858 ;;(setq href ;??

1859 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

1860 (delete-region b1 e1)

1861 (goto-char b1)

1862 (insert href))))

1863 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

1864 (if (and (equal attr "class") ;treat "class" attribute specially

1865 (setq css (yahtml-css-get-element-completion-alist tag)))

1866 (setq new (yahtml-read-parameter ;should be made generic?

1867 attr nil (list (cons "class" css))))

1868 ;;other than "class", read parameter normally

1869 (setq new (yahtml-read-parameter attr)))

1870 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

1871 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

1872 (insert new))

1873 (t

1874 (save-excursion

1875 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

1876 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

1877 (skip-chars-forward "^A-Za-z")

1878 (set-marker q (point))

1879 (setq p (point))

1880 (yahtml-goto-corresponding-begend)

1881 (or (= (char-after (point)) ?<)

1882 (skip-chars-backward "^<"))

1883 (skip-chars-forward "^A-Za-z")

1884 (if (= (char-after (1- (point))) ?/)

1885 (progn

1886 (set-marker q (point))

1887 (goto-char p)))

1888 (setq tag (let ((completion-ignore-case t))

1889 (YaTeX-cplread-with-learning

1890 (format "Change `%s' to(default %s): "

1891 tag yahtml-last-begend)

1892 'default 'user 'tmp)))

1893 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1894 (if (string= "" tag) (setq tag yahtml-last-begend))

1895 (setq yahtml-last-begend

1896 (or (cdr (assoc tag yahtml-env-table)) tag)

1897 tag yahtml-last-begend)

1898 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

1899 (insert (format "%s%s" tag (yahtml-addin tag)))

1900 (goto-char q)

1901 (set-marker q nil)

1902 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1903 (insert tag))))

1904 t))))

1905

1906 (defun yahtml-change-command ()

1907 (let ((p (point)) (case-fold-search t) cmd par new

1908 (beg (make-marker)) (end (make-marker)))

1909 (skip-chars-backward "^<")

1910 (if (and

1911 (looking-at yahtml-command-regexp)

1912 (progn

1913 (set-marker beg (match-beginning 0))

1914 (set-marker end (match-end 0))

1915 t) ;for further work

1916 (progn

1917 (forward-char -1)

1918 (condition-case nil

1919 (forward-list 1)

1920 (error nil))

1921 (< p (point))))

1922 (progn

1923 (goto-char p)

1924 (if (setq par (yahtml-on-assignment-p))

1925 (progn

1926 (setq new (yahtml-read-parameter par))

1927 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

1928 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

1929 (setq new

1930 (YaTeX-cplread-with-learning

1931 "Change form to: "

1932 'yahtml-form-table 'yahtml-user-form-table

1933 'yahtml-tmp-form-table)))

1934 (delete-region beg end)

1935 (goto-char beg)

1936 (set-marker beg nil)

1937 (set-marker end nil)

1938 (insert new)

1939 t)

1940 (goto-char p)

1941 nil)))

1942

1943 (defun yahtml-change-* ()

1944 "Change current position's HTML tag (set)."

1945 (interactive)

1946 (cond

1947 ((yahtml-change-begend))

1948 ((yahtml-change-command))

1949 ))

1950

1951 ;;; ---------- commenting ----------

1952

1953 (defun yahtml-comment-region (&optional uncom)

1954 "Comment out region or environment."

1955 (interactive)

1956 (let ((e (make-marker)) be beg p)

1957 (cond

1958 (;(marker-position (set-marker e (yahtml-on-begend-p)))

1959 (setq be (yahtml-on-begend-p))

1960 (save-excursion

1961 (setq p (point))

1962 (if (string-match "^/" be)

1963 (setq beg (progn (forward-line 1) (point)))

1964 (setq beg (progn (beginning-of-line) (point))))

1965 (goto-char p)

1966 (yahtml-goto-corresponding-begend)

1967 (if (string-match "^/" be)

1968 (beginning-of-line)

1969 (forward-line 1))

1970 (set-marker e (point))

1971 ;(comment-region beg (point) (if uncom (list 4)))

1972 ))

1973 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

1974 (setq beg (region-beginning))

1975 (set-marker e (region-end))))

1976 (if yahtml-translate-hyphens-when-comment-region

1977 (let ((yahtml-entity-reference-chars-alist-default nil)

1978 (yahtml-entity-reference-chars-alist '((?- . "#45")))

1979 yahtml-entity-reference-chars-regexp

1980 yahtml-entity-reference-chars-reverse-regexp)

1981 (yahtml-entity-reference-chars-setup)

1982 (funcall

1983 (if uncom 'yahtml-translate-reverse-region

1984 'yahtml-translate-region)

1985 beg e)))

1986 (comment-region beg e (if uncom (list 4)))

1987 (set-marker e nil)))

1988

1989 (defun yahtml-uncomment-region ()

1990 (interactive)

1991 (yahtml-comment-region t))

1992

1993 ;;; ---------- translate to entity references ----------

1994 (defvar yahtml-entity-reference-chars-alist-default

1995 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

1996 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

1997 "Default translation table from character to entity reference")

1998 (defvar yahtml-entity-reference-chars-alist nil

1999 "*Translation table from character to entity reference")

2000 (defvar yahtml-entity-reference-chars-regexp nil)

2001 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

2002

2003 (defun yahtml-entity-reference-chars-setup ()

2004 (let ((list (append yahtml-entity-reference-chars-alist-default

2005 yahtml-entity-reference-chars-alist)))

2006 (setq yahtml-entity-reference-chars-regexp "["

2007 yahtml-entity-reference-chars-reverse-regexp "&\\(")

2008 (while list

2009 (setq yahtml-entity-reference-chars-regexp

2010 (concat yahtml-entity-reference-chars-regexp

2011 (char-to-string (car (car list))))

2012 yahtml-entity-reference-chars-reverse-regexp

2013 (concat yahtml-entity-reference-chars-reverse-regexp

2014 (cdr (car list))

2015 (if (cdr list) "\\|")))

2016 (setq list (cdr list)))

2017 (setq yahtml-entity-reference-chars-regexp

2018 (concat yahtml-entity-reference-chars-regexp "]")

2019 yahtml-entity-reference-chars-reverse-regexp

2020 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

2021

2022 (yahtml-entity-reference-chars-setup)

2023

2024 (defun yahtml-translate-region (beg end)

2025 "Translate inhibited literals."

2026 (interactive "r")

2027 (save-excursion

2028 (save-restriction

2029 (narrow-to-region beg end)

2030 (let ((ct (append yahtml-entity-reference-chars-alist

2031 yahtml-entity-reference-chars-alist-default)))

2032 (goto-char beg)

2033 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

2034 ;(setq c (preceding-char))

2035 (replace-match

2036 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

2037

2038 (defun yahtml-translate-reverse-region (beg end)

2039 "Translate entity references to literals."

2040 (interactive "r")

2041 (save-excursion

2042 (save-restriction

2043 (narrow-to-region beg end)

2044 (let ((ct (append yahtml-entity-reference-chars-alist

2045 yahtml-entity-reference-chars-alist-default))

2046 ec)

2047 (goto-char beg)

2048 (while (re-search-forward

2049 yahtml-entity-reference-chars-reverse-regexp nil t)

2050 ;(setq c (preceding-char))

2051 (setq ec (YaTeX-match-string 1))

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

2053 (insert (car (YaTeX-rassoc ec ct))))))))

2054

2055 (defun yahtml-inner-environment-but (exclude &optional quick)

2056 "Return the inner environment but matches with EXCLUDE tag."

2057 (let (e (case-fold-search t))

2058 (save-excursion

2059 (while (and (setq e (YaTeX-inner-environment quick))

2060 (string-match exclude e))

2061 (goto-char (get 'YaTeX-inner-environment 'point))))

2062 e))

2063

2064 ;;; ---------- filling ----------

2065 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2066 (defun yahtml-move-to-column (col &optional force)

2067 (beginning-of-line)

2068 (let ((ccol 0))

2069 (while (and (> col ccol) (not (eolp)))

2070 (if (eq (following-char) ?\<)

2071 (progn

2072 (while (and (not (eq (following-char) ?\>))

2073 (not (eolp)))

2074 (forward-char))

2075 (or (eolp) (forward-char)))

2076 (or (eolp) (forward-char))

2077 (if (eq (preceding-char) ?\t)

2078 (let ((wd (- 8 (% (+ ccol 8) 8))))

2079 (if (and force (< col (+ ccol wd)))

2080 (progn

2081 (backward-char 1)

2082 (insert-char ?\ (- col ccol))

2083 (setq ccol col))

2084 (setq ccol (+ ccol wd))))

2085 (setq ccol (1+ ccol)))

2086 (if (and YaTeX-japan

2087 (or

2088 (and (fboundp 'char-category)

2089 (string-match "[chj]" (char-category (preceding-char))))

2090 (and (fboundp 'char-charset)

2091 (not (eq (char-charset (preceding-char)) 'ascii)))))

2092 (setq ccol (1+ ccol)))))

2093 (if (and force (> col ccol))

2094 (progn

2095 (insert-char ?\ (- col ccol))

2096 col)

2097 ccol)))

2098

2099 (defun yahtml-fill-paragraph (arg)

2100 (interactive "P")

2101 (let*((case-fold-search t) (p (point)) fill-prefix

2102 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2103 indent

2104 (startp (get 'YaTeX-inner-environment 'point))

2105 (prep (string-match "^pre$" e))

2106 (ps1 (if prep (default-value 'paragraph-start)

2107 paragraph-start))

2108 (ps2 (if prep (concat (default-value 'paragraph-start)

2109 "$\\|^\\s *</?pre>")

2110 paragraph-start)))

2111 (save-excursion

2112 (unwind-protect

2113 (progn

2114 (if prep

2115 (fset 'move-to-column 'yahtml-move-to-column))

2116 (save-excursion

2117 (beginning-of-line)

2118 (indent-to-column (yahtml-this-indent))

2119 (setq fill-prefix

2120 (buffer-substring (point) (point-beginning-of-line)))

2121 (delete-region (point) (point-beginning-of-line)))

2122 (fill-region-as-paragraph

2123 (progn (re-search-backward paragraph-start nil t)

2124 (or (save-excursion

2125 (goto-char (match-beginning 0))

2126 (if (looking-at "<")

2127 (forward-list)

2128 (goto-char (match-end 0))

2129 (skip-chars-forward " \t>"))

2130 (if (looking-at "[ \t]*$")

2131 (progn (forward-line 1) (point))))

2132 (point)))

2133 (progn (goto-char p)

2134 (re-search-forward ps2 nil t)

2135 (match-beginning 0))))

2136 (fset 'move-to-column yahtml-saved-move-to-column)))))

2137

2138 ;(defun yahtml-indent-new-commnet-line ()

2139 ; (unwind-protect

2140 ; (progn

2141 ; (fset 'move-to-column 'yahtml-move-to-column)

2142 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2143 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2144

2145 ;;;

2146 ;;; ---------- indentation ----------

2147 ;;;

2148 (defun yahtml-indent-line ()

2149 "Indent a line (faster wrapper)"

2150 (interactive)

2151 (let (indent)

2152 (if (and (save-excursion

2153 (beginning-of-line) (skip-chars-forward "\t ")

2154 (not (looking-at "<")))

2155 (save-excursion

2156 (forward-line -1)

2157 (while (and (not (bobp)) (looking-at "^\\s *$"))

2158 (forward-line -1))

2159 (skip-chars-forward "\t ")

2160 (setq indent (current-column))

2161 (not (looking-at "<"))))

2162 (progn

2163 (save-excursion

2164 (beginning-of-line)

2165 (skip-chars-forward " \t")

2166 (or (= (current-column) indent)

2167 (YaTeX-reindent indent)))

2168 (and (bolp) (skip-chars-forward " \t")))

2169 (yahtml-indent-line-real))))

2170

2171 (defun yahtml-this-indent ()

2173 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2174 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2175 (excludes

2176 "\$a\\|p\\|span\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2177 inenv p col peol (case-fold-search t))

2178 (save-excursion

2179 (beginning-of-line)

2180 (setq inenv (or (yahtml-inner-environment-but excludes t)

2181 "html")

2182 col (get 'YaTeX-inner-environment 'indent)

2183 p (get 'YaTeX-inner-environment 'point)

2184 op nil))

2185 (save-excursion

2186 (cond

2187 ((string-match (concat "^\$" envs "\$") inenv)

2188 (save-excursion

2189 (beginning-of-line)

2190 (skip-chars-forward " \t")

2191 (cond ;lookup current line's tag

2192 ((looking-at (concat "</\$" envs "\$>"))

2193 col)

2194 ((looking-at itms)

2195 (+ col yahtml-environment-indent))

2196 ((and yahtml-hate-too-deep-indentation

2197 (looking-at (concat "<\$" envs "\$")))

2198 (+ col (* 2 yahtml-environment-indent)))

2199 ((and (< p (point))

2200 (string-match itemizing-envs inenv)

2201 (save-excursion

2202 (and

2203 (setq op (point))

2204 (goto-char p)

2205 (re-search-forward itms op t)

2206 (progn

2207 (skip-chars-forward "^>")

2208 (skip-chars-forward ">")

2209 (skip-chars-forward " \t")

2210 (setq col (if (looking-at "$")

2211 (+ col yahtml-environment-indent)

2212 (current-column)))))))

2213 col)

2214 (t

2215 (+ col yahtml-environment-indent)))))

2216 (t col)))))

2217

2218 (defun yahtml-indent-line-real ()

2219 "Indent current line."

2220 (interactive)

2221 (YaTeX-reindent (yahtml-this-indent))

2222 (if (bolp) (skip-chars-forward " \t"))

2223 (let (peol col inenv)

2224 (if (and (setq inenv (yahtml-on-begend-p))

2225 (string-match

2226 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2227 (save-excursion

2228 (setq peol (point-end-of-line))

2229 (or (= (char-after (point)) ?<)

2230 (progn (skip-chars-backward "^<") (forward-char -1)))

2231 (setq col (current-column))

2232 (if (and (yahtml-goto-corresponding-begend t)

2233 (> (point) peol)) ;if on the different line

2234 (YaTeX-reindent col))))))

2235

2236 ;(defun yahtml-fill-item ()

2237 ; "Fill item HTML version"

2238 ; (interactive)

2239 ; (let (inenv p fill-prefix peol (case-fold-search t))

2240 ; (setq inenv (or (YaTeX-inner-environment) "html")

2241 ; p (get 'YaTeX-inner-environment 'point))

2242 ; (cond

2243 ; ((string-match "^[uod]l" inenv)

2244 ; (save-excursion

2245 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2246 ; (progn

2247 ; (goto-char (match-end 0))

2248 ; (setq col (current-column)))

2249 ; (error "No <li>, <dt>, <dd>")))

2250 ; (save-excursion

2251 ; (end-of-line)

2252 ; (setq peol (point))

2253 ; (newline)

2254 ; (indent-to-column col)

2255 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2256 ; (delete-region (point) peol)

2257 ; (fill-region-as-paragraph

2258 ; (progn (re-search-backward paragraph-start nil t) (point))

2259 ; (progn (re-search-forward paragraph-start nil t 2)

2260 ; (match-beginning 0)))))

2261 ; (t nil))))

2262

2263 ;;;

2264 ;;; ---------- Lint and Browsing ----------

2265 ;;;

2266 (defun yahtml-browse-menu ()

2267 "Browsing menu"

2268 (interactive)

2269 (message "J)weblint p)Browse R)eload...")

2270 (let ((c (char-to-string (read-char))))

2271 (cond

2272 ((string-match "j" c)

2273 (yahtml-lint-buffer (current-buffer)))

2274 ((string-match "[bp]" c)

2275 (yahtml-browse-current-file))

2276 ((string-match "r" c)

2277 (yahtml-browse-reload)))))

2278

2279 (if (fboundp 'wrap-function-to-control-ime)

2280 (wrap-function-to-control-ime 'yahtml-browse-menu t nil))

2281

2282 (defvar yahtml-lint-buffer "*weblint*")

2283

2284 (defun yahtml-lint-buffer (buf)

2285 "Call lint on buffer BUF."

2286 (require 'yatexprc)

2287 (interactive "bCall lint on buffer: ")

2288 (setq buf (get-buffer buf))

2289 (YaTeX-save-buffers)

2290 (YaTeX-typeset

2291 (concat yahtml-lint-program " "

2292 (file-name-nondirectory (buffer-file-name buf)))

2293 yahtml-lint-buffer "lint" "lint"))

2294

2295 (defun yahtml-file-to-url (file)

2296 "Convert local unix file name to URL.

2297 If no matches found in yahtml-path-url-alist, return raw file name."

2298 (let ((list yahtml-path-url-alist) p url)

2299 (if (file-directory-p file)

2300 (setq file (expand-file-name yahtml-directory-index file))

2301 (setq file (expand-file-name file)))

2302 (if (string-match "^[A-Za-z]:/" file)

2303 (progn

2304 ;; (aset file 1 ?|) ;これは要らないらしい…

2305 (setq file (concat "///" file))))

2306 (while list

2307 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2308 (setq url (cdr (car list))

2309 file (substring file (match-end 0))

2310 url (concat url file)

2311 list nil))

2312 (setq list (cdr list)))

2313 (or url (concat "file:" file))))

2314

2315 (defun yahtml-url-to-path (file &optional basedir)

2316 "Convert local URL name to unix file name."

2317 (let ((list yahtml-path-url-alist) url realpath docroot

2318 (dirsufp (string-match "/$" file)))

2319 (setq basedir (or basedir

2320 (file-name-directory

2321 (expand-file-name default-directory))))

2322 (cond

2323 ((string-match "^/" file)

2324 (while list

2325 (if (file-directory-p (car (car list)))

2326 (progn

2327 (setq url (cdr (car list)))

2328 (if (string-match "\$http://[^/]*\$/" url)

2329 (setq docroot (substring url (match-end 1)))

2330 (setq docroot url))

2331 (cond

2332 ((string-match (concat "^" (regexp-quote docroot)) file)

2333 (setq realpath

2334 (expand-file-name

2335 (substring

2336 file

2337 (if (= (aref file (1- (match-end 0))) ?/)

2338 (match-end 0) ; "/foo"

2339 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2340 (car (car list))))))

2341 (if realpath

2342 (progn (setq list nil)

2343 (if (and dirsufp (not (string-match "/$" realpath)))

2344 (setq realpath (concat realpath "/")))))))

2345 (setq list (cdr list)))

2346 realpath)

2347 (t file))))

2348

2349 (defun yahtml-browse-current-file ()

2350 "Call WWW browser on current file."

2351 (interactive)

2352 (basic-save-buffer)

2353 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2354

2355 (defun yahtml-browse-reload ()

2356 "Send `reload' event to netzscape."

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

2358 (cond

2359 ((string-match "[Nn]etscape" yahtml-www-browser)

2360 (if (get-buffer pb)

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

2362 ;;(or (get 'yahtml-netscape-sentinel 'url)

2363 ;; (error "Reload should be called after Browsing."))

2364 (put 'yahtml-netscape-sentinel 'url

2365 (yahtml-file-to-url (buffer-file-name)))

2366 (basic-save-buffer)

2367 (set-process-sentinel

2368 (setq yahtml-browser-process

2369 (start-process

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

2371 (format "%s -remote 'reload'" yahtml-www-browser)))

2372 'yahtml-netscape-sentinel))

2373 (t

2374 (message "Sorry, RELOAD is supported only for Netscape.")))))

2375

2376 ;;; ---------- Intelligent newline ----------

2377 (defun yahtml-intelligent-newline (arg)

2378 "Intelligent newline for HTML"

2379 (interactive "P")

2380 (let (env func)

2381 (end-of-line)

2382 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2383 "html")))

2384 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2385 (newline)

2386 (if (and env func (fboundp func))

2387 ;; if intelligent line function is defined, call that

2388 (funcall func)

2389 ;; else do the default action

2390 (if (string-match yahtml-p-prefered-env-regexp env)

2391 (yahtml-insert-p)))))

2392

2393 (defun yahtml-intelligent-newline-ul ()

2394 (interactive)

2395 (yahtml-insert-single "li")

2396 (or yahtml-faithful-to-htmllint (insert " "))

2397 (yahtml-indent-line))

2398

2399 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2400

2401 (defun yahtml-intelligent-newline-dl ()

2402 (interactive)

2403 (let ((case-fold-search t))

2404 (if (save-excursion

2405 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)>"

2406 (get 'YaTeX-inner-environment 'point) t))

2407 (cond

2408 ((match-beginning 2)

2409 (yahtml-insert-single "dd")

2410 (or yahtml-faithful-to-htmllint (insert " "))

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

2412 ((match-beginning 3)

2413 (yahtml-insert-single "dt")

2414 (or yahtml-faithful-to-htmllint (insert " "))

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

2416 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

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

2418 (yahtml-indent-line)

2419 (and (string-match yahtml-p-prefered-env-regexp "dl")

2420 (string-equal yahtml-last-single-cmd "dt")

2421 (yahtml-insert-p nil))))

2422

2423 (defun yahtml-intelligent-newline-select ()

2424 (interactive)

2425 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2426 (yahtml-indent-line))

2427

2428 (defun yahtml-intelligent-newline-style ()

2429 (interactive)

2430 (if (save-excursion

2431 (and

2432 (re-search-backward "<style\\|<!-- " nil t)

2433 (looking-at "<style")))

2434 (let (c)

2435 (yahtml-indent-line)

2436 (setq c (current-column))

2437 (insert "<!--\n")

2438 (YaTeX-reindent c)

2439 (insert "-->")

2440 (beginning-of-line)

2441 (open-line 1)

2442 (YaTeX-reindent c))))

2443

2444 ;;; ---------- Marking ----------

2445 (defun yahtml-mark-begend ()

2446 "Mark current tag"

2447 (interactive)

2448 (YaTeX-beginning-of-environment)

2449 (let ((p (point)))

2450 (save-excursion

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

2452 (if (bolp) (setq p (point))))

2453 (push-mark p t))

2454 (yahtml-goto-corresponding-begend)

2455 (forward-list 1)

2456 (if (eolp) (forward-char 1)))

2457

2458 ;;; ---------- complete marks ----------

2459 (defun yahtml-complete-mark ()

2460 "Complete &gt, &lt, &ampersand, and &quote."

2461 (interactive)

2462 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2463 (let ((c (read-char)))

2464 (setq c (if (or (< c ?0) (> c ?7))

2465 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2466 (- c ?1)))

2467 (if (or (< c 0) (> c 6))

2468 nil

2469 (insert (format "&%s;"

2470 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2471

2472

2473 ;;; ---------- jump to error line ----------

2474 (defun yahtml-prev-error ()

2475 "Jump to previous error seeing lint buffer."

2476 (interactive)

2477 (or (get-buffer yahtml-lint-buffer)

2478 (error "No lint program ran."))

2479 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2480 (yahtml-jump-to-error-line t))

2481

2482 (defun yahtml-jump-to-error-line (&optional sit)

2483 (interactive "P")

2484 (let ((p (point)) (e (point-end-of-line)))

2485 (end-of-line)

2486 (if (re-search-backward yahtml-error-line-regexp nil t)

2487 (let ((f (if (string= "" (YaTeX-match-string 1))

2488 YaTeX-current-file-name

2489 (YaTeX-match-string 1)))

2490 (l (string-to-int (or (YaTeX-match-string 2)

2491 (YaTeX-match-string 3)))))

2492 (if sit (sit-for 1))

2493 (forward-line -1)

2494 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2495 (goto-line l))

2496 (message "No line number usage"))))

2497

2498 ;;; ---------- Style Sheet Support ----------

2499 (defvar yahtml-css-class-alist nil

2500 "Alist of elements vs. their classes")

2501

2502 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2503 (save-excursion

2504 (save-restriction

2505 (narrow-to-region beg end)

2506 (goto-char (point-min))

2507 (let ((alist initial) b e element class a)

2508 (setq b (point))

2509 (while (search-forward "{" nil t)

2510 (setq e (point))

2511 (goto-char b)

2512 (while (re-search-forward ;ちょといい加減なREGEXP

2513 "\$[a-z][a-z0-9]*\$?\\.\$[a-z][a-z0-9]*\$\\>" e t)

2514 (setq element (YaTeX-match-string 1)

2515 class (YaTeX-match-string 2))

2516 ;;if starts with period (match-string 1 is nil),

2517 ;;this is global class

2518 (setq element (or element "global"))

2519 (if (setq a (assoc element alist))

2520 (or (assoc class (cdr a))

2521 (setcdr a (cons (list class) (cdr a))))

2522 (setq alist (cons (list element (list class)) alist))))

2523 (goto-char (1- e))

2524 (search-forward "}" nil t)

2525 (setq b (point)))

2526 alist))))

2527

2528 (defun yahtml-css-collect-classes-buffer (&optional initial)

2529 (interactive)

2530 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2531

2532 (defun yahtml-css-collect-classes-file (file &optional initial)

2533 (let*((hilit-auto-highlight nil)

2534 (openedp (get-file-buffer file))

2535 (cb (current-buffer))

2536 (buf (set-buffer (find-file-noselect file))))

2537 (prog1

2538 (yahtml-css-collect-classes-buffer initial)

2539 (or openedp (kill-buffer buf))

2540 (set-buffer cb))))

2541

2542 (defun yahtml-css-scan-styles ()

2543 (save-excursion

2544 (goto-char (point-min))

2545 (set (make-local-variable 'yahtml-css-class-alist) nil)

2546 (let (b tag type e href alist)

2547 (while (re-search-forward "<\$style\\|link\$" nil t)

2548 (setq b (match-beginning 0)

2549 tag (YaTeX-match-string 1))

2550 (cond

2551 ((string-match "style" tag)

2552 (goto-char b)

2553 (save-excursion (forward-list 1) (setq e (point)))

2554 (cond

2555 ((search-forward "text/css" e 1) ;css definition starts

2556 (setq alist

2557 (yahtml-css-collect-classes-region

2558 (point) (progn (search-forward "</style>") (point))

2559 alist)))))

2560 ((and (string-match "link" tag)

2561 (stringp (setq type (yahtml-get-attrvalue "type")))

2562 (string-match "text/css" type)

2563 (setq href (yahtml-get-attrvalue "href"))

2564 (file-exists-p (yahtml-url-to-path href)))

2565 (setq alist

2566 (yahtml-css-collect-classes-file

2567 (yahtml-url-to-path href) alist))))

2568 (setq yahtml-css-class-alist alist)))))

2569

2570 (defun yahtml-css-get-element-completion-alist (element)

2571 (let ((alist (cdr-safe (assoc element yahtml-css-class-alist)))

2572 (global (cdr-safe (assoc "global" yahtml-css-class-alist))))

2573 (and (or alist global)

2574 (append alist global))))

2575

2576 ;;; ---------- ----------

2577

2578 ;;;

2579 ;;hilit19

2580 ;;;

2581 (defvar yahtml-default-face-table

2582 '(

2583 (form black/ivory white/hex-442233 italic)

2584 ))

2585 (defvar yahtml-hilit-patterns-alist

2586 '(

2587 'case-fold

2588 ;; comments

2589 ("" comment)

2590 ;; include&exec

2591 ("" include)

2592 ;; string

2593 (hilit-string-find ?\\ string)

2594 (yahtml-hilit-region-tag "<\$em\\|strong\\|b\$\\>" bold)

2595 ("</?[uod]l>" 0 decl)

2596 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2597 (yahtml-hilit-region-tag "<\$i\\>\$" italic)

2598 ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..

2599 (yahtml-hilit-region-tag "<\$a\$\\s +href" crossref)

2600 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2601 ))

2602

2603 (defun yahtml-hilit-region-tag (tag)

2604 "Return list of start/end point of <TAG> form."

2605 (if (re-search-forward tag nil t)

2606 (let ((m0 (match-beginning 0)) (e0 (match-end 0))

2607 (elm (YaTeX-match-string 1)))

2608 (skip-chars-forward "^>")

2609 (prog1

2610 (cons (1+ (point))

2611 (progn (re-search-forward (concat "</" elm ">") nil t)

2612 (match-beginning 0)))

2613 (goto-char e0)))))

2614

2615 (defun yahtml-hilit-region-tag-itself (ptn)

2616 "Return list of start/end point of <tag options...> itself."

2617 (if (re-search-forward ptn nil t)

2618 (let ((m0 (match-beginning 0)))

2619 (skip-chars-forward "^>")

2620 (cons m0 (1+ (point) )))))

2621

2622 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2623 (and yahtml-use-hilit19

2624 (or (assq 'yahtml-mode hilit-patterns-alist)

2625 (setq hilit-patterns-alist

2626 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2627 hilit-patterns-alist))))

2628 ;;;

2629 ;; for font-lock

2630 ;;;

2631

2632 ; <<STATIC KEYWORDS BELOW NOT USED>>

2633 ;(defvar yahtml-font-lock-keywords

2634 ; '(

2635 ; ;; comments

2636 ; ("" . font-lock-comment-face)

2637 ; ;; include&exec

2638 ; (""

2639 ; 0 font-lock-include-face keep)

2640 ; ;; string

2641 ; ;(hilit-string-find ?\\ string)

2642 ; ;(yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2643 ; ("</?[uod]l>" 0 font-lock-keyword-face)

2644 ; ("<\$di\\|dt\\|li\\|dd\$>" 0 font-lock-label-face)

2645 ; ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))

2646 ; ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2647 ; ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))

2648 ; )

2649 ; "*Defualt font-lock-keywords for yahtml-mode.")

2650 (defvar yahtml-font-lock-keywords

2651 (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)

2652 "Default fontifying patterns for yahtml-mode")

2653

2654 (defun yahtml-font-lock-set-default-keywords ()

2655 (put 'yahtml-mode 'font-lock-defaults

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

2657

2658 (if yahtml-use-font-lock

2659 (progn

2660 (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)

2661 ;;for those who use both hilit19 and font-lock

2662 (if (eq (car hilit-mode-enable-list) 'not)

2663 (or (member 'yahtml-mode hilit-mode-enable-list)

2664 (nconc hilit-mode-enable-list (list 'yahtml-mode)))

2665 (setq hilit-mode-enable-list

2666 (delq 'yahtml-mode hilit-mode-enable-list))))

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

2668

2669 ;; (defun yahtml-fontify-to-tagend (lim)

2670 ;; "*Fontify any tag including < and >.

2671 ;; This is invalid use of font-lock function. Therefore

2672 ;; this fontifying will loose effectiveness soon or later."

2673 ;; (let ((start (match-beginning 0))

2674 ;; (end (progn (skip-chars-forward "^>") (1+ (point)))))

2675 ;; (or nil; (font-lock-any-faces-p start end)

2676 ;; (font-lock-fillin-text-property

2677 ;; start end 'face 'font-lock font-lock-keyword-face)))

2678 ;; nil)

2679

2680 (run-hooks 'yahtml-load-hook)

2681 (provide 'yahtml)

2682

2683 ; Local variables:

2684 ; fill-prefix: ";;; "

2685 ; paragraph-start: "^$\\|\\|;;;$"

2686 ; paragraph-separate: "^$\\|\\|;;;$"

2687 ; buffer-file-coding-system: sjis

2688 ; End: