yatex: 44e3a5e1e883 yahtml.el

yatex

view yahtml.el @ 70:44e3a5e1e883

Fix makefile for Windows Brush up label completion \cite completion Support much more about LaTeX2e --- [yahtml] English Info (By Jun Ohya) Automatic pixel size detection for <img src="..."> Aware global-class of css definition & for char-entity reference

author	yuuji
date	Sun, 09 Apr 2000 03:37:47 +0000
parents	807c1e7e68b7
children	0aaebd07dad0

line source

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

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

3 ;;; Last modified Wed Mar 1 23:28:22 2000 on firestorm

4 ;;; $Id$

6 ;;;[Installation]

7 ;;;

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

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

10 ;;;

11 ;;; (setq auto-mode-alist

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

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

14 ;;; (setq yahtml-www-browser "netscape")

15 ;;; ;Write your favorite browser. But netscape is advantageous.

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

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

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

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

20 ;;;

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

22 ;;;

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

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

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

26 ;;;

27 ;;; (setq auto-mode-alist

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

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

30 ;;; (setq yahtml-www-browser "netscape")

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

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

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

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

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

36 ;;;

37 ;;;[Commentary]

38 ;;;

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

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

41 ;;;

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

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

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

45 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

70 ;;; change the reference link with completion.

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

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

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

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

75 ;;; is "netscape")

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

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

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

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

80 ;;; in the region.

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

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

83 ;;; URLencoded string in the region.

84 ;;;

85 ;;;[キーの説明]

86 ;;;

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

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

89 ;;;

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

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

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

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

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

95 ;;; できます。

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

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

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

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

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

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

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

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

104 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

116 ;;; す。

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

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

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

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

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

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

123 ;;; きます。

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

125 ;;; す。

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

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

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

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

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

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

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

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

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

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

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

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

138 ;;;

139 ;;; [謝辞]

140 ;;;

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

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

143 ;;;

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

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

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

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

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

149 ;;;

150

151

152 ;(require 'yatex)

153 (require 'yatexlib)

154 ;;; --- customizable variable starts here ---

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

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

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

158 (defvar yahtml-www-browser "netscape"

159 "*WWW Browser command")

160 (defvar yahtml-kanji-code 2

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

162 ;;(defvar yahtml-coding-system

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

164 ;; "Kanji coding system")

165 (and (featurep 'mule)

166 (integerp yahtml-kanji-code)

167 (setq yahtml-kanji-code

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

169

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

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

172

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

174 (defvar yahtml-path-url-alist nil

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

176 Ex.

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

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

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

180 "*Directory index file name;

181 Consult your site's WWW administrator.")

182

183 (defvar yahtml-environment-indent 1

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

185

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

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

188

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

190 "*Program name to lint HTML file")

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

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

193

194 (defvar yahtml-always-/p nil

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

196

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

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

199

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

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

202

203 (defvar yahtml-prefer-upcases nil

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

205

206 (defvar yahtml-prefer-upcase-attributes nil

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

208

209 (defvar yahtml-server-type 'apache

210 "*WWW server program type")

211

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

213 "*Server access file name for apache")

214

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

216

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

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

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

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

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

222 %f: filename")

223

224 (defvar yahtml-use-hilit19 (featurep 'hilit19)

225 "*Use hilit19 to fontify buffer or not")

226

227 ;;; --- customizable variable ends here ---

228 (defvar yahtml-prefix-map nil)

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

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

231 (defvar yahtml-shell-command-option

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

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

234

235

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

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

238 (YaTeX-define-key

239 key

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

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

242 map))

243

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

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

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

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

248

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

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

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

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

253 (if YaTeX-inhibit-prefix-letter nil

254 (yahtml-define-begend-region-key

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

256

257 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

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

269 (let ((map yahtml-prefix-map))

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

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

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

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

274 (and YaTeX-emacs-19 window-system

275 (progn

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

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

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

279 (YaTeX-define-key "v" 'YaTeX-version map)

280 (YaTeX-define-key "}" 'YaTeX-insert-braces-region map)

281 (YaTeX-define-key "]" 'YaTeX-insert-brackets-region map)

282 (YaTeX-define-key ")" 'YaTeX-insert-parens-region map)

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

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

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

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

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

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

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

290 (if YaTeX-no-begend-shortcut

291 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

310 )

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

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

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

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

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

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

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

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

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

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

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

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

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

324 )

325 (let ((keys (where-is-internal 'fill-paragraph global-map)))

326 (while keys

327 (define-key yahtml-mode-map (car keys) 'yahtml-fill-paragraph)

328 (setq keys (cdr keys)))))

329

330 (if yahtml-lint-buffer-map nil

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

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

333

334

335 (defvar yahtml-paragraph-start

336 (concat

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

338 "*Regexp of html paragraph separater")

339 (defvar yahtml-paragraph-separate

340 (concat

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

342 "*Regexp of html paragraph separater")

343 (defvar yahtml-syntax-table nil

344 "*Syntax table for yahtml-mode")

345

346 (if yahtml-syntax-table nil

347 (setq yahtml-syntax-table

348 (make-syntax-table (standard-syntax-table)))

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

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

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

352 )

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

354 "Regexp of constituent of html commands.")

355

356 ;;; Completion tables for `form'

357 (defvar yahtml-form-table

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

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

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

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

362

363 (defvar yahtml-env-table

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

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

366 ("OrderedList" . "ol")

367 ("UnorderedList" . "ul")

368 ("DefinitionList" . "dl")

369 ("Preformatted" . "pre")

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

371 ("address")

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

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

374 ("style") ("div") ("object")

375 ))

376

377 ;(defvar yahtml-itemizing-regexp

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

379 ; "Regexp of itemizing forms")

380

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

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

383

384 ;;; Completion tables for typeface designator

385 (and yahtml-always-/p

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

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

388

389 (defvar yahtml-typeface-table

390 (append

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

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

393 ("sup") ("sub") ("span"))

394 yahtml-env-table)

395 "Default completion table of typeface designator")

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

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

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

399

400 (defvar yahtml-single-cmd-table

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

402 ("HorizontalLine" . "hr")

403 ("BreakLine" . "br")

404 ("Paragraph" . "p")

405 ("Item" . "li")

406 ("DefineTerm" . "dt")

407 ("Description" . "dd")

408 ("dd") ("dt") ("li")

409 )

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

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

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

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

414

415 (defvar yahtml-current-completion-type nil

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

417

418 ;(defvar yahtml-struct-name-regexp

420 (defvar yahtml-struct-name-regexp

421 (concat

422 "\\<\\("

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

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

425 "\\)\\b")

426 "Regexp of structure beginning.")

427

428 (defvar yahtml-closable-regexp

429 (concat

430 "\\<\\("

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

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

433 "\\)\\b")

434 "Regexp of any closable elemnts.")

435

436

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

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

439

440

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

442 (cond

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

444 buffer-file-name)

445 (let ((dir default-directory)

446 charset af ext (ldir "")

447 line

448 (case-fold-search t)

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

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

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

452 (while (and dir

453 (not (string= dir ldir))

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

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

456 (if (file-exists-p af)

457 (save-excursion

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

459 (save-excursion

460 (goto-char (point-min))

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

462 (setq line (buffer-substring

463 (point-beginning-of-line)

464 (point-end-of-line))

465 dir nil)))

466 (kill-buffer (current-buffer))))

467 (if dir

468 (setq ldir dir

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

470 dir (file-name-directory dir))))

471 line

472 ))

473 (t nil))

474 )

475

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

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

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

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

480 line

481 charset)

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

483 (progn

484 (string-match ptn line)

485 (setq charset

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

487 (cond

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

489 (setq charset 2))

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

491 (setq charset 3))

492 ((string-match "shift_jis" charset)

493 (setq charset 1))

494 (t (setq charset nil)))

495 (setq dir "")))

496 (if (featurep 'mule)

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

498 charset))

499

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

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

502 x index-list)

503 ;;s/\\s *$//;

504 (if line

505 (progn

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

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

508 (while (string< "" line)

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

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

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

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

513 line ""))

514 )

515 (or (nreverse index-list)

516 (if (listp yahtml-directory-index)

517 yahtml-directory-index

518 (list yahtml-directory-index)))))))

519

520 (defun yahtml-mode ()

521 (interactive)

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

523 (cond

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

525 (setq buffer-file-coding-system coding))

526 ((featurep 'mule)

527 (set-file-coding-system coding))

528 ((boundp 'NEMACS)

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

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

531 (setq major-mode 'yahtml-mode

532 mode-name "yahtml")

533 (mapcar

534 (function (lambda (x)

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

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

537 (boundp (cdr x)))

538 (symbol-value (cdr x))

539 (cdr x)))))

540 '((YaTeX-ec . "")

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

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

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

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

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

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

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

548 (paragraph-start . yahtml-paragraph-start)

549 (paragraph-separate . yahtml-paragraph-separate)

550 (comment-start . "")

551 (comment-start-skip . comment-start)

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

553

554 (set-syntax-table yahtml-syntax-table)

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

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

557 (yahtml-css-scan-styles)

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

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

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

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

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

563

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

565 (cond

566 ((featurep 'xemacs)

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

568 (set keymap nil)

569 (mapcar

570 (function

571 (lambda (bind)

572 (setq bind (cdr bind))

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

574 (setcar (cdr bind) 'progn))

575 (if (stringp (car (cdr bind)))

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

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

578 (symbol-value keymap))))))

579 bindlist)

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

581 (t

582 (mapcar

583 (function

584 (lambda (bind)

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

586 bindlist))))

587

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

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

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

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

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

593

594 ;;; Variables for mosaic url history

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

596 (defvar yahtml-urls-private nil)

597 (defvar yahtml-urls-local nil)

598

599 (cond

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

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

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

603 (YaTeX-define-menu

604 'yahtml-menu-map-sectioning

605 (nreverse

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

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

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

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

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

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

612 )))

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

614 (YaTeX-define-menu

615 'yahtml-menu-map-logical

616 (nreverse

617 '((em "Embolden" .

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

619 (dfn "Define a word" .

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

621 (cite "Citation" .

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

623 (code "Code" .

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

625 (kbd "Keyboard" .

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

627 (samp "Sample display" .

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

629 (strong "Strong" .

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

631 (VAR "Variable notation" .

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

633 )))

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

635 (YaTeX-define-menu

636 'yahtml-menu-map-typeface

637 (nreverse

638 '((b "Bold" .

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

640 (i "Italic" .

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

642 (tt "Typewriter" .

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

644 (u "Underlined" .

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

646 )))

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

648 (YaTeX-define-menu

649 'yahtml-menu-map-listing

650 (nreverse

651 '((ul "Unordered" .

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

653 (ol "Ordered" .

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

655 (dl "Definition" .

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

657 )))

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

659 (YaTeX-define-menu

660 'yahtml-menu-map-item

661 (nreverse

662 '((li "Simple item" .

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

664 (dt "Define term" .

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

666 (dd "Description of term" .

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

668 )))

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

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

671 (YaTeX-define-menu

672 'yahtml-menu-map

673 (nreverse

674 (list

675 (cons (list 'sect "Sectioning")

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

677 (cons (list 'list "Listing")

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

679 (cons (list 'item "Item")

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

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

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

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

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

685 )))

686 (if (featurep 'xemacs)

687 (add-hook 'yahtml-mode-hook

688 '(lambda ()

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

690 (progn

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

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

693 ))

694

695 ;;; ----------- Completion ----------

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

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

698 "Insert <cmd> ... </cmd>."

699 (interactive "P")

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

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

702 (cmd

703 (or env

704 (YaTeX-cplread-with-learning

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

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

707 (bolp (save-excursion

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

709 (cc (current-column)))

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

711 (setq yahtml-last-begend

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

713 yahtml-last-begend))

714 (setq cmd yahtml-last-begend)

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

716 (if region

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

718 ;; to enable continuous regioning by another environment

719 (let ((beg (region-beginning))

720 (end (region-end))

721 (addin (yahtml-addin cmd)))

722 (save-excursion

723 (goto-char end)

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

725 (goto-char beg)

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

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

728 (save-excursion

729 (insert "\n")

730 (indent-to-column cc)

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

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

733 (newline)

734 (yahtml-intelligent-newline nil))

735 (yahtml-indent-line))))

736

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

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

739 (interactive)

740 (yahtml-insert-begend t))

741

742

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

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

745 (interactive)

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

747 (or form

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

749 (setq form

750 (YaTeX-cplread-with-learning

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

752 'yahtml-form-table 'yahtml-user-form-table

753 'yahtml-tmp-form-table))))

754 (let ((p (point)) q)

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

756 (setq yahtml-last-form form)

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

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

759 ;;(indent-relative-maybe)

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

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

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

763

764 ;;; ---------- Add-in ----------

765 (defun yahtml-addin (form)

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

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

768 (concat

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

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

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

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

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

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

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

776 (string< "" s))

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

778 ""))))

779

780

781 (defvar yahtml-completing-buffer nil)

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

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

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

785 (let (list end)

786 (save-excursion

787 (set-buffer yahtml-completing-buffer)

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

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

790 (save-excursion

791 (goto-char (point-min))

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

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

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

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

796 (setq end (match-end 0))

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

798 (yahtml-on-assignment-p)

799 (progn

800 (goto-char end)

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

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

803 (setq list (cons

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

805 list))))

806 list)))

807 )

808

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

810 (if yahtml-url-completion-map nil

811 (setq yahtml-url-completion-map

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

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

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

815 )

816

817 (defun yahtml-complete-url ()

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

819 (interactive)

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

821 (setq initial (buffer-string))

822 (cond

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

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

825 listfunc (list 'lambda nil

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

827 beg (point-min)))

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

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

830 (progn

831 (setq path (substring initial 0 beg))

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

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

834 (setq initial (substring initial beg))

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

836 cmpl (try-completion initial labels)

837 listfunc (list 'lambda ()

838 (list 'all-completions

839 initial (list 'quote labels)))

840 beg (+ (point-min) beg)))

841 (t

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

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

844 initial))

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

846 file (file-name-nondirectory path)

847 initial file

848 cmpl (file-name-completion file dir)

849 listfunc (list 'lambda nil

850 (list 'file-name-all-completions

851 file dir))

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

853 (cond

854 ((stringp cmpl)

855 (if (string= initial cmpl)

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

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

858 (princ

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

860 (delete-region (point) beg)

861 (insert cmpl)))

862 ((null cmpl)

863 (ding))

864 ((eq t cmpl)

865 (save-excursion

866 (unwind-protect

867 (progn

868 (goto-char p)

869 (insert " [Sole completion]"))

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

871

872 (defvar yahtml-escape-chars 'ask

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

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

875 at each reserved chars.")

876

877 ;

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

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

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

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

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

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

884 ;

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

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

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

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

889 (defvar yahtml-unsafe-chars-regexp

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

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

892 ;

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

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

895 ;

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

897 ; "$" | ","

898 (defvar yahtml-unreserved-chars-regexp

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

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

901 Not used yet.")

902

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

904 "Translate reserved chars to URL encoded string."

905 (let ((p 0) (target "")

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

907 (cond

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

909 (t

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

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

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

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

914 (setq target (concat target

915 (substring str 0 p)

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

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

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

919 (concat target str)))))

920

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

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

923 (interactive "r")

924 (save-excursion

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

926 (goto-char beg)

927 (while (and (< (point) e)

928 (re-search-forward

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

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

931 (sit-for 0)

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

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

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

935 ; (unwind-protect

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

937 ; (save-excursion

938 ; (backward-char 1)

939 ; (delete-backward-char 4))

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

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

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

943 (progn

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

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

946 (set-marker e nil))))

947 ;; ab%defgls/.|

948

949 (defun yahtml:a ()

950 "Add-in function for <a>"

951 (let ((href ""))

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

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

954 href (yahtml-escape-chars-string

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

956 (prog1

957 (concat (yahtml-make-optional-argument

958 "href" href)

959 (yahtml-make-optional-argument

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

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

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

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

964 (YaTeX-update-table

965 (list href)

966 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

967 )))

968

969 (defvar yahtml-parameters-completion-alist

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

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

972 ("src" . file)

973 ("background" . file)

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

975 ("method" ("POST") ("GET"))

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

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

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

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

980

981 (defvar yahtml-link-types-alist

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

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

984 ("subsection") ("appendix") ("help") ("bookmark")))

985

986 (defvar yahtml-content-types-alist

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

988 ("text/sgml") ("text/xml")

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

990 ("application/java")

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

992 "Alist of content-types")

993

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

995 (let* ((alist

996 (cdr-safe (assoc (downcase par)

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

998 (prompt (concat par ": "))

999 v)

1000 (cond

1001 ((eq alist 'file)

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

1003 ((and alist (symbolp alist))

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

1005 (alist

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

1007 (t

1008 (read-string prompt default)))))

1009

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

1011 "Make optional argument string."

1012 (if (string= "" arg)

1013 ""

1014 (concat " "

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

1016 "=\"" arg "\"")))

1017

1018 (defun yahtml:body ()

1019 "Add-in function for <body>"

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

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

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

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

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

1025 (concat

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

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

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

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

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

1031

1032 (defun yahtml:img ()

1033 "Add-in function for <img>"

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

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

1036 alt

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

1038 (l yahtml-prefer-upcase-attributes)

1039 info width height bytes comments)

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

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

1042 (car info)

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

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

1045 bytes (car (cdr (cdr info)))

1046 comments (nth 4 info)))

1047 (if info

1048 (setq alt

1049 (YaTeX-replace-formats

1050 yahtml:img-default-alt-format

1051 (list (cons "x" width)

1052 (cons "y" height)

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

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

1055 (cons "c" (car comments))))))

1056

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

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

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

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

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

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

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

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

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

1066

1067 (defun yahtml-file-truename (file)

1068 (cond

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

1070 (t (let ((new file))

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

1072 (not (equal new file)))

1073 (setq file new))

1074 file))))

1075

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

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

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

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

1080 (let ((mlt 1)

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

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

1083 (value 0))

1084 (while (> length 0)

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

1086 pos (+ pos direc)

1087 mlt (* mlt 256)

1088 length (1- length)))

1089 value))

1090

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

1092 "Return the information on the image file FILE.

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

1094 (save-excursion

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

1096 width height bytes depth comment

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

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

1099 (seekpoint 1)

1100 c1 c2 c3 c4 beg end

1101 (case-fold-search nil))

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

1103 (set-buffer tmpbuf)

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

1105 (erase-buffer)

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

1107 (unwind-protect

1108 (progn

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

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

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

1112 (YaTeX-insert-file-contents

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

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

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

1116 c2 (char-after 2)

1117 c3 (char-after 3)

1118 c4 (char-after 4))

1119 (cond

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

1121 ;;JPEG images need JPEG markers inspection

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

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

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

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

1126 (catch 'exit

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

1128 (cond

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

1130 ;maybe corrupted, exit from loop

1131 (throw 'exit t))

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

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

1134 ;;found!

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

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

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

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

1139 ;; JPEG comment area

1140 (setq beg (+ seekpoint 2 2)

1141 end (+ seekpoint

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

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

1144 (t ;other markers

1145 nil)) ;just skip it

1146 (setq seekpoint (+ seekpoint 2)

1147 seekpoint (+ seekpoint

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

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

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

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

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

1153 height (yahtml-hex-value 20 4)

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

1155 ((looking-at "GIF8")

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

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

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

1159 ((looking-at "BM")

1160 ;;# OS/2, Windoze BMP files

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

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

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

1164 (cond

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

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

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

1168 (t

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

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

1171 ))

1172 (message "")

1173 (kill-buffer tmpbuf))

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

1175

1176 (defun yahtml:form ()

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

1178 (concat

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

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

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

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

1183 ))

1184

1185 (defun yahtml:select ()

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

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

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

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

1190

1191 (defun yahtml:ol ()

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

1193 (defun yahtml:ul ()

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

1195 (defun yahtml:dl ()

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

1197 (defun yahtml:dt ()

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

1199

1200 (defun yahtml:p ()

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

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

1203 ))

1204

1205 (defvar yahtml-input-types

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

1207 ("reset") ("image") ("hidden") ("file")))

1208

1209 (defun yahtml:input ()

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

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

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

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

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

1215 yahtml-input-types nil t)

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

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

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

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

1220 (concat

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

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

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

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

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

1226 )))

1227

1228 (defun yahtml:textarea ()

1229 "Add-in function for `textarea'"

1230 (interactive)

1231 (let (name rows cols)

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

1233 cols (read-string "Columns: ")

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

1235 (concat

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

1237 "\"" name "\"")

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

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

1240

1241 (defun yahtml:table ()

1242 "Add-in function for `table'"

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

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

1245 (concat

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

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

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

1249 (defun yahtml:caption ()

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

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

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

1253

1254 (defun yahtml:font ()

1255 "Add-in function for `font'"

1256 (concat

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

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

1259

1260 (defun yahtml:style ()

1261 "Add-in function for `style'"

1262 (yahtml-make-optional-argument

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

1264

1265 (defun yahtml:tr ()

1266 "Add-in function for `tr'"

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

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

1269 "")

1270

1271 (defun yahtml:link ()

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

1273 (let (rel rev type href)

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

1275 (cond

1276 ((equal rel "")

1277 (concat (yahtml-make-optional-argument

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

1279 (yahtml-make-optional-argument

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

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

1282 )))

1283 ((string-match "stylesheet" rel)

1284 (concat

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

1286 (yahtml-make-optional-argument

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

1288 (progn

1289 (setq href

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

1291 (if (string< "" href)

1292 (progn

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

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

1295 (setq yahtml-css-class-alist

1296 (yahtml-css-collect-classes-file

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

1298 (message "")

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

1300 (t ;;??

1301 ))))

1302

1303 (defun yahtml:br ()

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

1305

1306 (defun yahtml:object ()

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

1308 data classid)

1309 (cond

1310 ((string-match "java" codetype)

1311 (let ((completion-ignored-extensions

1312 ;;any extensions except ".class"

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

1314 (setq classid (concat "java:"

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

1316 (concat

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

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

1319 (yahtml-make-optional-argument

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

1321 (yahtml-make-optional-argument

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

1323 (yahtml-make-optional-argument

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

1325 ))

1326 (t

1327 ""

1328 ))))

1329

1330 ;;; ---------- Simple tag ----------

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

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

1333 (interactive "P")

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

1335 (or tag

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

1337 (setq tag

1338 (YaTeX-cplread-with-learning

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

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

1341 'yahtml-typeface-table 'yahtml-user-typeface-table

1342 'yahtml-tmp-typeface-table))))

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

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

1345 (setq yahtml-last-typeface-cmd tag

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

1347 (if region-mode

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

1349 (save-excursion

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

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

1352 (exchange-point-and-mark)

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

1354 (message "No mark set now"))

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

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

1357

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

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

1360 (interactive)

1361 (yahtml-insert-tag t tag))

1362

1363

1364 (defun yahtml-insert-single (cmd)

1365 "Insert <CMD>."

1366 (interactive

1367 (list

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

1369 (YaTeX-cplread-with-learning

1370 (format "Command%s: "

1371 (if yahtml-last-single-cmd

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

1373 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

1376 (setq yahtml-last-single-cmd

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

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

1379 yahtml-last-single-cmd))

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

1381

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

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

1384 (interactive "P")

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

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

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

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

1389

1390 (defun yahtml-insert-amps (arg)

1391 "Insert char-entity references via ampersand"

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

1393 (interactive "P")

1394 (let*((mess "") c

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

1396 yahtml-entity-reference-chars-alist))

1397 (l list))

1398 (while l

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

1400 l (cdr l)))

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

1402 (setq c (read-char))

1403 (cond

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

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

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

1407 (insert "&;")

1408 (forward-char -1))

1409 ((equal c ? )

1410 (insert ?&))

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

1412

1413 ;;; ---------- Jump ----------

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

1415 "Check if point is on href clause."

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

1417 (save-excursion

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

1419 (save-excursion

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

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

1422 (setq e (point)))

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

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

1425 (search-forward "href" e t)

1426 (search-forward "=" e t)

1427 (progn

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

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

1430 (< p (match-end 0))

1431 (YaTeX-match-string 1)

1432 ))))

1433

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

1435 (cond

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

1437 (set-process-buffer proc nil))

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

1439 (let ((cb (current-buffer)))

1440 (set-buffer (process-buffer proc))

1441 (goto-char (point-min))

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

1443 (progn

1444 (message "Starting netscape...")

1445 (start-process

1446 "browser" (process-buffer proc)

1447 shell-file-name yahtml-shell-command-option

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

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

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

1451 (set-buffer cb)))))

1452

1453 (defvar yahtml-browser-process nil)

1454

1455 (defun yahtml-browse-html (href)

1456 "Call WWW Browser to see HREF."

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

1458 (cond

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

1460 (if (get-buffer pb)

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

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

1463 (set-process-sentinel

1464 (setq yahtml-browser-process

1465 (start-process

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

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

1468 'yahtml-netscape-sentinel))

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

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

1471 (if (get-buffer pb)

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

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

1474 (set-process-sentinel

1475 (setq yahtml-browser-process

1476 (start-process

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

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

1479 'yahtml-netscape-sentinel))

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

1481 (w3-fetch href))

1482 ((stringp yahtml-www-browser)

1483 (if (and yahtml-browser-process

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

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

1486 (setq yahtml-browser-process

1487 (start-process

1488 "browser" "* WWW Browser *"

1489 shell-file-name yahtml-shell-command-option

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

1491 (t

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

1493

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

1495 "Go to corresponding name."

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

1497 (if href

1498 (cond

1499 ((string-match "^\$ht\\|f\$tp:" href)

1500 (yahtml-browse-html href))

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

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

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

1504 (if (string< "" file)

1505 (progn

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

1507 (or (catch 'dirindex

1508 (mapcar

1509 (lambda (f)

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

1511 (throw 'dirindex

1512 (setq file (concat file f)))))

1513 (yahtml-get-directory-index)))

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

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

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

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

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

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

1520 (if name

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

1522 t)))))

1523

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

1525 "Jump to html's named tag."

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

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

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

1529 (message "Named tag `%s' not found" (substring href 1))))

1530

1531 (defun yahtml-on-begend-p (&optional p)

1532 "Check if point is on begend clause."

1533 (let ((p (or p (point))) cmd (case-fold-search t))

1534 (save-excursion

1535 (goto-char p)

1536 (if (equal (char-after (point)) ?<) (forward-char 1))

1537 (if (and (re-search-backward "<" nil t)

1538 (looking-at

1539 ;(concat "<\$/?" yahtml-struct-name-regexp "\$\\b")

1540 "<\$/?[A-Z][A-Z0-9]*\$\\b"

1541 )

1542 (condition-case nil

1543 (forward-list 1)

1544 (error nil))

1545 (< p (point)))

1546 (YaTeX-match-string 1)))))

1547

1548 (defun yahtml-goto-corresponding-begend (&optional noerr)

1549 "Go to corresponding opening/closing tag.

1550 Optional argument NOERR causes no error for unballanced tag."

1551 (let ((cmd (yahtml-on-begend-p)) m0

1552 (p (point)) (case-fold-search t) func str (nest 0))

1553 (cond

1554 (cmd

1555 (setq m0 (match-beginning 0))

1556 (if (= (aref cmd 0) ?/) ;on </cmd> line

1557 (setq cmd (substring cmd 1)

1558 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1559 func 're-search-backward)

1560 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1561 func 're-search-forward))

1562 (while (and (>= nest 0) (funcall func str nil t))

1563 (if (equal m0 (match-beginning 0))

1564 nil

1565 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1566 (if (< nest 0)

1567 (goto-char (match-beginning 0))

1568 (funcall

1569 (if noerr 'message 'error)

1570 "Corresponding tag of `%s' not found." cmd)

1571 (goto-char p)

1572 nil))

1573 (t nil))))

1574

1575 (defun yahtml-current-tag ()

1576 "Return the current tag name."

1577 (save-excursion

1578 (let ((p (point)) b tag)

1579 (or (bobp)

1580 (looking-at "<")

1581 (progn (skip-chars-backward "^<") (forward-char -1)))

1582 (setq b (point))

1583 (skip-chars-forward "<")

1584 (setq tag (buffer-substring

1585 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1586 (goto-char b)

1587 (forward-list 1)

1588 (and (< p (point)) tag))))

1589

1590

1591 (defun yahtml-goto-corresponding-img ()

1592 "View image on point"

1593 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1594 (if (and tag

1595 (string-match "img" tag)

1596 (save-excursion

1597 (re-search-backward "<\\s *img" nil t)

1598 (re-search-forward "src=\"?\$[^\"> ]+\$\"?")

1599 (match-beginning 1)

1600 (setq image

1601 (buffer-substring (match-beginning 1) (match-end 1)))))

1602 (progn

1603 (message "Invoking %s %s..." yahtml-image-viewer image)

1604 (start-process

1605 "Viewer" " * Image Viewer *"

1606 shell-file-name yahtml-shell-command-option ;"-c"

1607 (concat yahtml-image-viewer " " image))

1608 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1609

1610 (defun yahtml-get-attrvalue (attr)

1611 "Extract current tag's attribute value from buffer."

1612 (let (e (case-fold-search t))

1613 (save-excursion

1614 (or (looking-at "<")

1615 (progn (skip-chars-backward "^<") (backward-char 1)))

1616 (setq e (save-excursion (forward-list 1) (point)))

1617 (if (and

1618 (re-search-forward (concat "\\b" attr "\\b") e t)

1619 (progn (skip-chars-forward " \t\n=")

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

1621 (YaTeX-match-string 1)))))

1622

1623 (defun yahtml-goto-corresponding-source (&optional other)

1624 "Goto applet's source."

1625 (let ((env (yahtml-current-tag)) s (p (point)))

1626 (cond

1627 ((string-match "applet" env)

1628 (if (setq s (yahtml-get-attrvalue "code"))

1629 (progn

1630 (setq s (YaTeX-match-string 1)

1631 s (concat

1632 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1633 ".java"))

1634 (if other (YaTeX-switch-to-buffer-other-window s)

1635 (YaTeX-switch-to-buffer s))

1636 s) ;return source file name

1637 (message "No applet source specified")

1638 (sit-for 1)

1639 nil))

1640 ((string-match "!--#include" env)

1641 (cond

1642 ((setq s (yahtml-get-attrvalue "file")) ;

1643 (if other (YaTeX-switch-to-buffer-other-window s)

1644 (YaTeX-switch-to-buffer s))

1645 s)

1646 ((setq s (yahtml-get-attrvalue "virtual"));

1647 (setq s (yahtml-url-to-path s))

1648 (if other (YaTeX-switch-to-buffer-other-window s)

1649 (YaTeX-switch-to-buffer s))

1650 s)))

1651 ((and (string-match "!--#exec" env)

1652 (setq s (yahtml-get-attrvalue "cmd")))

1653 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1654 (let ((b " *yahtmltmp*")) ;peek a little

1655 (unwind-protect

1656 (progn

1657 (set-buffer (get-buffer-create b))

1658 (YaTeX-insert-file-contents s nil 0 100)

1659 (if (looking-at "#!")

1660 (if other (YaTeX-switch-to-buffer-other-window s)

1661 (YaTeX-switch-to-buffer s))))

1662 (kill-buffer (get-buffer b)))

1663 (get-file-buffer s))))))

1664

1665 (defun yahtml-goto-corresponding-* (&optional other)

1666 "Go to corresponding object."

1667 (interactive)

1668 (cond

1669 ((yahtml-goto-corresponding-href other))

1670 ((yahtml-goto-corresponding-img))

1671 ((yahtml-goto-corresponding-begend))

1672 ((yahtml-goto-corresponding-source other))

1673 (t (message "I don't know where to go."))

1674 ))

1675

1676 (defun yahtml-goto-corresponding-*-other-window ()

1677 "Go to corresponding object."

1678 (interactive)

1679 (yahtml-goto-corresponding-* t))

1680

1681 (defun yahtml-visit-main ()

1682 "Go to parent file from where you visit current file."

1683 (interactive)

1684 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1685

1686 ;;; ---------- killing ----------

1687 (defun yahtml-kill-begend (&optional whole)

1688 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1689 (if tag

1690 (save-excursion

1691 (or (looking-at "<")

1692 (progn (skip-chars-backward "^<") (forward-char -1)))

1693 (setq p (point))

1694 (yahtml-goto-corresponding-begend)

1695 (or (looking-at "<")

1696 (progn (skip-chars-backward "^<") (forward-char -1)))

1697 (if (< (point) p) ;if on the opening tag

1698 (progn (setq q p p (point))

1699 (goto-char q))

1700 (setq q (point))) ;now q has end-line's (point)

1701 (if (not whole)

1702 (kill-region

1703 (progn (skip-chars-backward " \t")

1704 (if (setq bbolp (bolp)) (point) q))

1705 (progn (forward-list 1)

1706 (setq r (point))

1707 (skip-chars-forward " \t")

1708 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1709 (goto-char p)

1710 (skip-chars-backward " \t")

1711 (if (not whole)

1712 (progn

1713 (kill-append

1714 (buffer-substring

1715 (setq p (if (setq bbolp (bolp)) (point) p))

1716 (setq q (progn

1717 (forward-list 1)

1718 (setq r (point))

1719 (skip-chars-forward " \t")

1720 (if (and bbolp (eolp) (not (eobp)))

1721 (1+ (point))

1722 r))))

1723 t)

1724 (delete-region p q))

1725 (kill-region

1726 (if (bolp) (point) p)

1727 (progn (goto-char q)

1728 (forward-list 1)

1729 (setq r (point))

1730 (skip-chars-forward " \t")

1731 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1732 tag))))

1733

1734 (defun yahtml-kill-* (whole)

1735 "Kill current position's HTML tag (set)."

1736 (interactive "P")

1737 (cond

1738 ((yahtml-kill-begend whole))

1739 ))

1740

1741

1742 ;;; ---------- changing ----------

1743 (defun yahtml-on-assignment-p ()

1744 "Return if current point is on parameter assignment.

1745 If so, return parameter name, otherwise nil.

1746 This function should be able to treat white spaces in value, but not yet."

1747 (let ((p (point)))

1748 (save-excursion

1749 (put 'yahtml-on-assignment-p 'region nil)

1750 (skip-chars-backward "^ \t\n")

1751 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

1752 (< p (match-end 0))

1753 (>= p (1- (match-beginning 2)))

1754 (put 'yahtml-on-assignment-p 'region

1755 (cons (match-beginning 2) (match-end 2)))

1756 (YaTeX-match-string 1)))))

1757

1758 (defun yahtml-change-begend ()

1759 (let ((tag (yahtml-on-begend-p))

1760 (completion-ignore-case t)

1761 (case-fold-search t)

1762 (p (point)) (q (make-marker))

1763 (default (append yahtml-env-table yahtml-typeface-table))

1764 (user (append yahtml-user-env-table yahtml-user-typeface-table))

1765 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

1766 href b1 e1 attr new css)

1767 (cond

1768 (tag

1769 (cond

1770 ((and (string-match "^a$" tag)

1771 (save-excursion

1772 (and

1773 (re-search-backward "<a\\b" nil t)

1774 (progn

1775 (goto-char (match-end 0))

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

1777 (setq b1 (point))

1778 (search-forward ">" nil t))

1779 (setq e1 (match-beginning 0))

1780 (goto-char b1)

1781 (re-search-forward "href\\s *=" e1 t)

1782 (>= p (point))

1783 (progn

1784 (goto-char (match-end 0))

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

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

1787 (< p (match-end 0)))))

1788 (setq b1 (match-beginning 1) e1 (match-end 1)

1789 yahtml-completing-buffer (current-buffer)

1790 ;; yahtml-urls-local is buffer-local, so we must put

1791 ;; that into yahtml-urls here

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

1793 href (read-from-minibuffer

1794 "Change href to: " "" yahtml-url-completion-map))

1795 (if (string< "" href)

1796 (progn

1797 ;;(setq href ;??

1798 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

1799 (delete-region b1 e1)

1800 (goto-char b1)

1801 (insert href))))

1802 ((setq attr (yahtml-on-assignment-p)) ;if on the assignment to attr

1803 (if (and (equal attr "class") ;treat "class" attribute specially

1804 (setq css (yahtml-css-get-element-completion-alist tag)))

1805 (setq new (yahtml-read-parameter ;should be made generic?

1806 attr nil (list (cons "class" css))))

1807 ;;other than "class", read parameter normally

1808 (setq new (yahtml-read-parameter attr)))

1809 (goto-char (car (get 'yahtml-on-assignment-p 'region)))

1810 (delete-region (point) (cdr (get 'yahtml-on-assignment-p 'region)))

1811 (insert new))

1812 (t

1813 (save-excursion

1814 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

1815 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

1816 (skip-chars-forward "^A-Za-z")

1817 (set-marker q (point))

1818 (setq p (point))

1819 (yahtml-goto-corresponding-begend)

1820 (or (= (char-after (point)) ?<)

1821 (skip-chars-backward "^<"))

1822 (skip-chars-forward "^A-Za-z")

1823 (if (= (char-after (1- (point))) ?/)

1824 (progn

1825 (set-marker q (point))

1826 (goto-char p)))

1827 (setq tag (let ((completion-ignore-case t))

1828 (YaTeX-cplread-with-learning

1829 (format "Change `%s' to(default %s): "

1830 tag yahtml-last-begend)

1831 'default 'user 'tmp)))

1832 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1833 (if (string= "" tag) (setq tag yahtml-last-begend))

1834 (setq yahtml-last-begend

1835 (or (cdr (assoc tag yahtml-env-table)) tag)

1836 tag yahtml-last-begend)

1837 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

1838 (insert (format "%s%s" tag (yahtml-addin tag)))

1839 (goto-char q)

1840 (set-marker q nil)

1841 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1842 (insert tag))))

1843 t))))

1844

1845 (defun yahtml-change-command ()

1846 (let ((p (point)) (case-fold-search t) cmd par new

1847 (beg (make-marker)) (end (make-marker)))

1848 (skip-chars-backward "^<")

1849 (if (and

1850 (looking-at yahtml-command-regexp)

1851 (progn

1852 (set-marker beg (match-beginning 0))

1853 (set-marker end (match-end 0))

1854 t) ;for further work

1855 (progn

1856 (forward-char -1)

1857 (condition-case nil

1858 (forward-list 1)

1859 (error nil))

1860 (< p (point))))

1861 (progn

1862 (goto-char p)

1863 (if (setq par (yahtml-on-assignment-p))

1864 (progn

1865 (setq new (yahtml-read-parameter par))

1866 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

1867 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

1868 (setq new

1869 (YaTeX-cplread-with-learning

1870 "Change form to: "

1871 'yahtml-form-table 'yahtml-user-form-table

1872 'yahtml-tmp-form-table)))

1873 (delete-region beg end)

1874 (goto-char beg)

1875 (set-marker beg nil)

1876 (set-marker end nil)

1877 (insert new)

1878 t)

1879 (goto-char p)

1880 nil)))

1881

1882 (defun yahtml-change-* ()

1883 "Change current position's HTML tag (set)."

1884 (interactive)

1885 (cond

1886 ((yahtml-change-begend))

1887 ((yahtml-change-command))

1888 ))

1889

1890 ;;; ---------- commenting ----------

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

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

1893

1894 (defun yahtml-comment-region (&optional uncom)

1895 "Comment out region or environment."

1896 (interactive)

1897 (let ((e (make-marker)) beg p)

1898 (cond

1899 ((marker-position (set-marker e (yahtml-on-begend-p)))

1900 (save-excursion

1901 (setq p (point))

1902 (if (string-match "^/" e)

1903 (setq beg (progn (forward-line 1) (point)))

1904 (setq beg (progn (beginning-of-line) (point))))

1905 (goto-char p)

1906 (yahtml-goto-corresponding-begend)

1907 (if (string-match "^/" e)

1908 (beginning-of-line)

1909 (forward-line 1))

1910 (set-marker e (point))

1911 ;(comment-region beg (point) (if uncom (list 4)))

1912 ))

1913 (t ;(comment-region (region-beginning) (region-end) (if uncom (list 4)))

1914 (setq beg (region-beginning))

1915 (set-marker e (region-end))))

1916 (if yahtml-translate-hyphens-when-comment-region

1917 (let ((yahtml-entity-reference-chars-alist-default nil)

1918 (yahtml-entity-reference-chars-alist '((?- . "#45")))

1919 yahtml-entity-reference-chars-regexp

1920 yahtml-entity-reference-chars-reverse-regexp)

1921 (yahtml-entity-reference-chars-setup)

1922 (funcall

1923 (if uncom 'yahtml-translate-reverse-region

1924 'yahtml-translate-region)

1925 beg e)))

1926 (comment-region beg e (if uncom (list 4)))

1927 (set-marker e nil)))

1928

1929 (defun yahtml-uncomment-region ()

1930 (interactive)

1931 (yahtml-comment-region t))

1932

1933 ;;; ---------- translate to entity references ----------

1934 (defvar yahtml-entity-reference-chars-alist-default

1935 ;'((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot") (?' . "apos"))

1936 '((?> . "gt") (?< . "lt") (?& . "amp") (?\" . "quot"))

1937 "Default translation table from character to entity reference")

1938 (defvar yahtml-entity-reference-chars-alist nil

1939 "*Translation table from character to entity reference")

1940 (defvar yahtml-entity-reference-chars-regexp nil)

1941 (defvar yahtml-entity-reference-chars-reverse-regexp nil)

1942

1943 (defun yahtml-entity-reference-chars-setup ()

1944 (let ((list (append yahtml-entity-reference-chars-alist-default

1945 yahtml-entity-reference-chars-alist)))

1946 (setq yahtml-entity-reference-chars-regexp "["

1947 yahtml-entity-reference-chars-reverse-regexp "&\\(")

1948 (while list

1949 (setq yahtml-entity-reference-chars-regexp

1950 (concat yahtml-entity-reference-chars-regexp

1951 (char-to-string (car (car list))))

1952 yahtml-entity-reference-chars-reverse-regexp

1953 (concat yahtml-entity-reference-chars-reverse-regexp

1954 (cdr (car list))

1955 (if (cdr list) "\\|")))

1956 (setq list (cdr list)))

1957 (setq yahtml-entity-reference-chars-regexp

1958 (concat yahtml-entity-reference-chars-regexp "]")

1959 yahtml-entity-reference-chars-reverse-regexp

1960 (concat yahtml-entity-reference-chars-reverse-regexp "\\);"))))

1961

1962 (yahtml-entity-reference-chars-setup)

1963

1964 (defun yahtml-translate-region (beg end)

1965 "Translate inhibited literals."

1966 (interactive "r")

1967 (save-excursion

1968 (save-restriction

1969 (narrow-to-region beg end)

1970 (let ((ct (append yahtml-entity-reference-chars-alist

1971 yahtml-entity-reference-chars-alist-default)))

1972 (goto-char beg)

1973 (while (re-search-forward yahtml-entity-reference-chars-regexp nil t)

1974 ;(setq c (preceding-char))

1975 (replace-match

1976 (concat "&" (cdr (assoc (preceding-char) ct)) ";")))))))

1977

1978 (defun yahtml-translate-reverse-region (beg end)

1979 "Translate entity references to literals."

1980 (interactive "r")

1981 (save-excursion

1982 (save-restriction

1983 (narrow-to-region beg end)

1984 (let ((ct (append yahtml-entity-reference-chars-alist

1985 yahtml-entity-reference-chars-alist-default))

1986 ec)

1987 (goto-char beg)

1988 (while (re-search-forward

1989 yahtml-entity-reference-chars-reverse-regexp nil t)

1990 ;(setq c (preceding-char))

1991 (setq ec (YaTeX-match-string 1))

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

1993 (insert (car (YaTeX-rassoc ec ct))))))))

1994

1995 (defun yahtml-inner-environment-but (exclude &optional quick)

1996 "Return the inner environment but matches with EXCLUDE tag."

1997 (let (e (case-fold-search t))

1998 (save-excursion

1999 (while (and (setq e (YaTeX-inner-environment quick))

2000 (string-match exclude e))

2001 (goto-char (get 'YaTeX-inner-environment 'point))))

2002 e))

2003

2004 ;;; ---------- filling ----------

2005 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

2006 (defun yahtml-move-to-column (col &optional force)

2007 (beginning-of-line)

2008 (let ((ccol 0))

2009 (while (and (> col ccol) (not (eolp)))

2010 (if (eq (following-char) ?\<)

2011 (progn

2012 (while (and (not (eq (following-char) ?\>))

2013 (not (eolp)))

2014 (forward-char))

2015 (or (eolp) (forward-char)))

2016 (or (eolp) (forward-char))

2017 (if (eq (preceding-char) ?\t)

2018 (let ((wd (- 8 (% (+ ccol 8) 8))))

2019 (if (and force (< col (+ ccol wd)))

2020 (progn

2021 (backward-char 1)

2022 (insert-char ?\ (- col ccol))

2023 (setq ccol col))

2024 (setq ccol (+ ccol wd))))

2025 (setq ccol (1+ ccol)))

2026 (if (and YaTeX-japan

2027 (or

2028 (and (fboundp 'char-category)

2029 (string-match "[chj]" (char-category (preceding-char))))

2030 (and (fboundp 'char-charset)

2031 (not (eq (char-charset (preceding-char)) 'ascii)))))

2032 (setq ccol (1+ ccol)))))

2033 (if (and force (> col ccol))

2034 (progn

2035 (insert-char ?\ (- col ccol))

2036 col)

2037 ccol)))

2038

2039 (defun yahtml-fill-paragraph (arg)

2040 (interactive "P")

2041 (let*((case-fold-search t) (p (point)) fill-prefix

2042 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

2043 indent

2044 (startp (get 'YaTeX-inner-environment 'point))

2045 (prep (string-match "^pre$" e))

2046 (ps1 (if prep (default-value 'paragraph-start)

2047 paragraph-start))

2048 (ps2 (if prep (concat (default-value 'paragraph-start)

2049 "$\\|^\\s *</?pre>")

2050 paragraph-start)))

2051 (save-excursion

2052 (unwind-protect

2053 (progn

2054 (if prep

2055 (fset 'move-to-column 'yahtml-move-to-column))

2056 (save-excursion

2057 (beginning-of-line)

2058 (indent-to-column (yahtml-this-indent))

2059 (setq fill-prefix

2060 (buffer-substring (point) (point-beginning-of-line)))

2061 (delete-region (point) (point-beginning-of-line)))

2062 (fill-region-as-paragraph

2063 (progn (re-search-backward paragraph-start nil t)

2064 (or (save-excursion

2065 (goto-char (match-beginning 0))

2066 (if (looking-at "<")

2067 (forward-list)

2068 (goto-char (match-end 0))

2069 (skip-chars-forward " \t>"))

2070 (if (looking-at "[ \t]*$")

2071 (progn (forward-line 1) (point))))

2072 (point)))

2073 (progn (goto-char p)

2074 (re-search-forward ps2 nil t)

2075 (match-beginning 0))))

2076 (fset 'move-to-column yahtml-saved-move-to-column)))))

2077

2078 ;(defun yahtml-indent-new-commnet-line ()

2079 ; (unwind-protect

2080 ; (progn

2081 ; (fset 'move-to-column 'yahtml-move-to-column)

2082 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

2083 ; (fset 'move-to-column yahtml-saved-move-to-column)))

2084

2085 ;;;

2086 ;;; ---------- indentation ----------

2087 ;;;

2088 (defun yahtml-indent-line ()

2089 "Indent a line (faster wrapper)"

2090 (interactive)

2091 (let (indent)

2092 (if (and (save-excursion

2093 (beginning-of-line) (skip-chars-forward "\t ")

2094 (not (looking-at "<")))

2095 (save-excursion

2096 (forward-line -1)

2097 (while (and (not (bobp)) (looking-at "^\\s *$"))

2098 (forward-line -1))

2099 (skip-chars-forward "\t ")

2100 (setq indent (current-column))

2101 (not (looking-at "<"))))

2102 (progn

2103 (save-excursion

2104 (beginning-of-line)

2105 (skip-chars-forward " \t")

2106 (or (= (current-column) indent)

2107 (YaTeX-reindent indent)))

2108 (and (bolp) (skip-chars-forward " \t")))

2109 (yahtml-indent-line-real))))

2110

2111 (defun yahtml-this-indent ()

2113 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

2114 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

2115 (excludes

2116 "\$a\\|p\\|span\\|tt\\|em\\|u\\|i\\|big\\|small\\|font\$\\b")

2117 inenv p col peol (case-fold-search t))

2118 (save-excursion

2119 (beginning-of-line)

2120 (setq inenv (or (yahtml-inner-environment-but excludes t)

2121 "html")

2122 col (get 'YaTeX-inner-environment 'indent)

2123 p (get 'YaTeX-inner-environment 'point)

2124 op nil))

2125 (save-excursion

2126 (cond

2127 ((string-match (concat "^\$" envs "\$") inenv)

2128 (save-excursion

2129 (beginning-of-line)

2130 (skip-chars-forward " \t")

2131 (cond ;lookup current line's tag

2132 ((looking-at (concat "</\$" envs "\$>"))

2133 col)

2134 ((looking-at itms)

2135 (+ col yahtml-environment-indent))

2136 ((and yahtml-hate-too-deep-indentation

2137 (looking-at (concat "<\$" envs "\$")))

2138 (+ col (* 2 yahtml-environment-indent)))

2139 ((and (< p (point))

2140 (string-match itemizing-envs inenv)

2141 (save-excursion

2142 (and

2143 (setq op (point))

2144 (goto-char p)

2145 (re-search-forward itms op t)

2146 (progn

2147 (skip-chars-forward "^>")

2148 (skip-chars-forward ">")

2149 (skip-chars-forward " \t")

2150 (setq col (if (looking-at "$")

2151 (+ col yahtml-environment-indent)

2152 (current-column)))))))

2153 col)

2154 (t

2155 (+ col yahtml-environment-indent)))))

2156 (t col)))))

2157

2158 (defun yahtml-indent-line-real ()

2159 "Indent current line."

2160 (interactive)

2161 (YaTeX-reindent (yahtml-this-indent))

2162 (if (bolp) (skip-chars-forward " \t"))

2163 (let (peol col inenv)

2164 (if (and (setq inenv (yahtml-on-begend-p))

2165 (string-match

2166 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

2167 (save-excursion

2168 (setq peol (point-end-of-line))

2169 (or (= (char-after (point)) ?<)

2170 (progn (skip-chars-backward "^<") (forward-char -1)))

2171 (setq col (current-column))

2172 (if (and (yahtml-goto-corresponding-begend t)

2173 (> (point) peol)) ;if on the different line

2174 (YaTeX-reindent col))))))

2175

2176 ;(defun yahtml-fill-item ()

2177 ; "Fill item HTML version"

2178 ; (interactive)

2179 ; (let (inenv p fill-prefix peol (case-fold-search t))

2180 ; (setq inenv (or (YaTeX-inner-environment) "html")

2181 ; p (get 'YaTeX-inner-environment 'point))

2182 ; (cond

2183 ; ((string-match "^[uod]l" inenv)

2184 ; (save-excursion

2185 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

2186 ; (progn

2187 ; (goto-char (match-end 0))

2188 ; (setq col (current-column)))

2189 ; (error "No <li>, <dt>, <dd>")))

2190 ; (save-excursion

2191 ; (end-of-line)

2192 ; (setq peol (point))

2193 ; (newline)

2194 ; (indent-to-column col)

2195 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

2196 ; (delete-region (point) peol)

2197 ; (fill-region-as-paragraph

2198 ; (progn (re-search-backward paragraph-start nil t) (point))

2199 ; (progn (re-search-forward paragraph-start nil t 2)

2200 ; (match-beginning 0)))))

2201 ; (t nil))))

2202

2203 ;;;

2204 ;;; ---------- Lint and Browsing ----------

2205 ;;;

2206 (defun yahtml-browse-menu ()

2207 "Browsing menu"

2208 (interactive)

2209 (message "J)weblint p)Browse R)eload...")

2210 (let ((c (char-to-string (read-char))))

2211 (cond

2212 ((string-match "j" c)

2213 (yahtml-lint-buffer (current-buffer)))

2214 ((string-match "[bp]" c)

2215 (yahtml-browse-current-file))

2216 ((string-match "r" c)

2217 (yahtml-browse-reload)))))

2218

2219 (defvar yahtml-lint-buffer "*weblint*")

2220

2221 (defun yahtml-lint-buffer (buf)

2222 "Call lint on buffer BUF."

2223 (require 'yatexprc)

2224 (interactive "bCall lint on buffer: ")

2225 (setq buf (get-buffer buf))

2226 (YaTeX-save-buffers)

2227 (YaTeX-typeset

2228 (concat yahtml-lint-program " "

2229 (file-name-nondirectory (buffer-file-name buf)))

2230 yahtml-lint-buffer "lint" "lint"))

2231

2232 (defun yahtml-file-to-url (file)

2233 "Convert local unix file name to URL.

2234 If no matches found in yahtml-path-url-alist, return raw file name."

2235 (let ((list yahtml-path-url-alist) p url)

2236 (if (file-directory-p file)

2237 (setq file (expand-file-name yahtml-directory-index file))

2238 (setq file (expand-file-name file)))

2239 (if (string-match "^[A-Za-z]:/" file)

2240 (progn

2241 ;; (aset file 1 ?|) ;これは要らないらしい…

2242 (setq file (concat "///" file))))

2243 (while list

2244 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

2245 (setq url (cdr (car list))

2246 file (substring file (match-end 0))

2247 url (concat url file)

2248 list nil))

2249 (setq list (cdr list)))

2250 (or url (concat "file:" file))))

2251

2252 (defun yahtml-url-to-path (file &optional basedir)

2253 "Convert local URL name to unix file name."

2254 (let ((list yahtml-path-url-alist) url realpath docroot

2255 (dirsufp (string-match "/$" file)))

2256 (setq basedir (or basedir

2257 (file-name-directory

2258 (expand-file-name default-directory))))

2259 (cond

2260 ((string-match "^/" file)

2261 (while list

2262 (if (file-directory-p (car (car list)))

2263 (progn

2264 (setq url (cdr (car list)))

2265 (if (string-match "\$http://[^/]*\$/" url)

2266 (setq docroot (substring url (match-end 1)))

2267 (setq docroot url))

2268 (cond

2269 ((string-match (concat "^" (regexp-quote docroot)) file)

2270 (setq realpath

2271 (expand-file-name

2272 (substring

2273 file

2274 (if (= (aref file (1- (match-end 0))) ?/)

2275 (match-end 0) ; "/foo"

2276 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

2277 (car (car list))))))

2278 (if realpath

2279 (progn (setq list nil)

2280 (if (and dirsufp (not (string-match "/$" realpath)))

2281 (setq realpath (concat realpath "/")))))))

2282 (setq list (cdr list)))

2283 realpath)

2284 (t file))))

2285

2286 (defun yahtml-browse-current-file ()

2287 "Call WWW browser on current file."

2288 (interactive)

2289 (basic-save-buffer)

2290 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

2291

2292 (defun yahtml-browse-reload ()

2293 "Send `reload' event to netzscape."

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

2295 (cond

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

2297 (if (get-buffer pb)

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

2299 ;;(or (get 'yahtml-netscape-sentinel 'url)

2300 ;; (error "Reload should be called after Browsing."))

2301 (put 'yahtml-netscape-sentinel 'url

2302 (yahtml-file-to-url (buffer-file-name)))

2303 (basic-save-buffer)

2304 (set-process-sentinel

2305 (setq yahtml-browser-process

2306 (start-process

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

2308 (format "%s -remote 'reload'" yahtml-www-browser)))

2309 'yahtml-netscape-sentinel))

2310 (t

2311 (message "Sorry, RELOAD is supported only for Netscape.")))))

2312

2313 ;;; ---------- Intelligent newline ----------

2314 (defun yahtml-intelligent-newline (arg)

2315 "Intelligent newline for HTML"

2316 (interactive "P")

2317 (let (env func)

2318 (end-of-line)

2319 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

2320 "html")))

2321 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

2322 (newline)

2323 (if (and env func (fboundp func))

2324 ;; if intelligent line function is defined, call that

2325 (funcall func)

2326 ;; else do the default action

2327 (if (string-match yahtml-p-prefered-env-regexp env)

2328 (yahtml-insert-p)))))

2329

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

2331 (defun yahtml-intelligent-newline-ul ()

2332 (interactive)

2333 (yahtml-insert-single "li")

2334 (or yahtml-faithful-to-htmllint (insert " "))

2335 (yahtml-indent-line))

2336

2337 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

2338

2339 (defun yahtml-intelligent-newline-dl ()

2340 (interactive)

2341 (let ((case-fold-search t))

2342 (if (save-excursion

2343 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)>"

2344 (get 'YaTeX-inner-environment 'point) t))

2345 (cond

2346 ((match-beginning 2)

2347 (yahtml-insert-single "dd")

2348 (or yahtml-faithful-to-htmllint (insert " "))

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

2350 ((match-beginning 3)

2351 (yahtml-insert-single "dt")

2352 (or yahtml-faithful-to-htmllint (insert " "))

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

2354 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

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

2356 (yahtml-indent-line)

2357 (and (string-match yahtml-p-prefered-env-regexp "dl")

2358 (string-equal yahtml-last-single-cmd "dt")

2359 (yahtml-insert-p nil))))

2360

2361 (defun yahtml-intelligent-newline-select ()

2362 (interactive)

2363 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

2364 (yahtml-indent-line))

2365

2366 (defun yahtml-intelligent-newline-style ()

2367 (interactive)

2368 (if (save-excursion

2369 (and

2370 (re-search-backward "<style\\|<!-- " nil t)

2371 (looking-at "<style")))

2372 (let (c)

2373 (yahtml-indent-line)

2374 (setq c (current-column))

2375 (insert "<!--\n")

2376 (YaTeX-reindent c)

2377 (insert "-->")

2378 (beginning-of-line)

2379 (open-line 1)

2380 (YaTeX-reindent c))))

2381

2382 ;;; ---------- Marking ----------

2383 (defun yahtml-mark-begend ()

2384 "Mark current tag"

2385 (interactive)

2386 (YaTeX-beginning-of-environment)

2387 (let ((p (point)))

2388 (save-excursion

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

2390 (if (bolp) (setq p (point))))

2391 (push-mark p t))

2392 (yahtml-goto-corresponding-begend)

2393 (forward-list 1)

2394 (if (eolp) (forward-char 1)))

2395

2396 ;;; ---------- complete marks ----------

2397 (defun yahtml-complete-mark ()

2398 "Complete &gt, &lt, &ampersand, and &quote."

2399 (interactive)

2400 (message "1:< 2:> 3:& 4:\" 5:' 6:nbsp")

2401 (let ((c (read-char)))

2402 (setq c (if (or (< c ?0) (> c ?7))

2403 (string-match (regexp-quote (char-to-string c)) "<>&\"")

2404 (- c ?1)))

2405 (if (or (< c 0) (> c 6))

2406 nil

2407 (insert (format "&%s;"

2408 (nth c '("lt" "gt" "amp" "quot" "apos" "nbsp")))))))

2409

2410

2411 ;;; ---------- jump to error line ----------

2412 (defvar yahtml-error-line-regexp

2413 "^\$.*\$(\$[0-9]+\$):"

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

2415 (defun yahtml-prev-error ()

2416 "Jump to previous error seeing lint buffer."

2417 (interactive)

2418 (or (get-buffer yahtml-lint-buffer)

2419 (error "No lint program ran."))

2420 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

2421 (yahtml-jump-to-error-line t))

2422

2423 (defun yahtml-jump-to-error-line (&optional sit)

2424 (interactive "P")

2425 (let ((p (point)) (e (point-end-of-line)))

2426 (end-of-line)

2427 (if (re-search-backward yahtml-error-line-regexp nil t)

2428 (let ((f (YaTeX-match-string 1))

2429 (l (string-to-int (YaTeX-match-string 2))))

2430 (if sit (sit-for 1))

2431 (forward-line -1)

2432 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

2433 (goto-line l))

2434 (message "No line number usage"))))

2435

2436 ;;; ---------- Style Sheet Support ----------

2437 (defvar yahtml-css-class-alist nil

2438 "Alist of elements vs. their classes")

2439

2440 (defun yahtml-css-collect-classes-region (beg end &optional initial)

2441 (save-excursion

2442 (save-restriction

2443 (narrow-to-region beg end)

2444 (goto-char (point-min))

2445 (let ((alist initial) b e element class a)

2446 (setq b (point))

2447 (while (search-forward "{" nil t)

2448 (setq e (point))

2449 (goto-char b)

2450 (while (re-search-forward ;ちょといい加減なREGEXP

2451 "\$[a-z][a-z0-9]*\$?\\.\$[a-z][a-z0-9]*\$\\>" e t)

2452 (setq element (YaTeX-match-string 1)

2453 class (YaTeX-match-string 2))

2454 ;;if starts with period (match-string 1 is nil),

2455 ;;this is global class

2456 (setq element (or element "global"))

2457 (if (setq a (assoc element alist))

2458 (or (assoc class (cdr a))

2459 (setcdr a (cons (list class) (cdr a))))

2460 (setq alist (cons (list element (list class)) alist))))

2461 (goto-char (1- e))

2462 (search-forward "}" nil t)

2463 (setq b (point)))

2464 alist))))

2465

2466 (defun yahtml-css-collect-classes-buffer (&optional initial)

2467 (interactive)

2468 (yahtml-css-collect-classes-region (point-min) (point-max) initial))

2469

2470 (defun yahtml-css-collect-classes-file (file &optional initial)

2471 (let*((hilit-auto-highlight nil)

2472 (openedp (get-file-buffer file))

2473 (cb (current-buffer))

2474 (buf (set-buffer (find-file-noselect file))))

2475 (prog1

2476 (yahtml-css-collect-classes-buffer initial)

2477 (or openedp (kill-buffer buf))

2478 (set-buffer cb))))

2479

2480 (defun yahtml-css-scan-styles ()

2481 (save-excursion

2482 (goto-char (point-min))

2483 (set (make-local-variable 'yahtml-css-class-alist) nil)

2484 (while (re-search-forward "<\$style\\|link\$" nil t)

2485 (let ((b (match-beginning 0))(tag (YaTeX-match-string 1)) e href alist)

2486 (cond

2487 ((string-match "style" tag)

2488 (goto-char b)

2489 (save-excursion (forward-list 1) (setq e (point)))

2490 (cond

2491 ((search-forward "text/css" e 1) ;css definition starts

2492 (setq alist

2493 (yahtml-css-collect-classes-region

2494 (point) (progn (search-forward "</style>") (point))

2495 alist)))))

2496 ((and (string-match "link" tag)

2497 (setq href (yahtml-get-attrvalue "href"))

2498 (file-exists-p (yahtml-url-to-path href)))

2499 (setq alist

2500 (yahtml-css-collect-classes-file

2501 (yahtml-url-to-path href) alist))))

2502 (setq yahtml-css-class-alist alist)))))

2503

2504 (defun yahtml-css-get-element-completion-alist (element)

2505 (let ((alist (cdr-safe (assoc element yahtml-css-class-alist)))

2506 (global (cdr-safe (assoc "global" yahtml-css-class-alist))))

2507 (and (or alist global)

2508 (append alist global))))

2509

2510 ;;; ---------- ----------

2511

2512 ;;;

2513 ;;hilit19

2514 ;;;

2515 (defvar yahtml-default-face-table

2516 '(

2517 (form black/ivory white/hex-442233 italic)

2518 ))

2519 (defvar yahtml-hilit-patterns-alist

2520 '(

2521 'case-fold

2522 ;; comments

2523 ("" comment)

2524 ;; include&exec

2525 ("" include)

2526 ;; string

2527 (hilit-string-find ?\\ string)

2528 (yahtml-hilit-region-tag "\$em\\|strong\$" bold)

2529 ("</?[uod]l>" 0 decl)

2530 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

2531 ("<a\\s +href" "</a>" crossref)

2532 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

2533 ))

2534

2535 (defun yahtml-hilit-region-tag (tag)

2536 "Return list of start/end point of <TAG> form."

2537 (if (re-search-forward (concat "<" tag ">") nil t)

2538 (let ((m0 (match-beginning 0)))

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

2540 (cons (point)

2541 (progn (re-search-forward (concat "</" tag ">") nil t)

2542 (match-beginning 0))))))

2543

2544 (defun yahtml-hilit-region-tag-itself (ptn)

2545 "Return list of start/end point of <tag options...> itself."

2546 (if (re-search-forward ptn nil t)

2547 (let ((m0 (match-beginning 0)))

2548 (skip-chars-forward "^>")

2549 (cons m0 (1+ (point) )))))

2550

2551 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

2552 (and yahtml-use-hilit19

2553 (or (assq 'yahtml-mode hilit-patterns-alist)

2554 (setq hilit-patterns-alist

2555 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

2556 hilit-patterns-alist))))

2557

2558 (run-hooks 'yahtml-load-hook)

2559 (provide 'yahtml)

2560

2561 ; Local variables:

2562 ; fill-prefix: ";;; "

2563 ; paragraph-start: "^$\\|\\|;;;$"

2564 ; paragraph-separate: "^$\\|\\|;;;$"

2565 ; End: