yatex: 0eb6997bee16 yahtml.el

yatex

view yahtml.el @ 68:0eb6997bee16

More adjustment for Emacs20 and XEmacs [prefix] g for <applet> <!--#include> <!--#exec>

author	yuuji
date	Mon, 26 Oct 1998 12:05:32 +0000
parents	36a48185b95a
children	807c1e7e68b7

line source

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

2 ;;; (c ) 1994-1997 by HIROSE Yuuji [yuuji@ae.keio.ac.jp]

3 ;;; Last modified Mon Oct 26 19:57:36 1998 on firestorm

4 ;;; $Id$

5 (defconst yahtml-revision-number "1.65.5"

6 "Revision number of running yatex.el")

8 ;;;[Installation]

9 ;;;

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

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

12 ;;;

13 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

22 ;;;

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

24 ;;;

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

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

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

28 ;;;

29 ;;; (setq auto-mode-alist

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

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

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

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

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

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

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

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

38 ;;;

39 ;;;[Commentary]

40 ;;;

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

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

43 ;;;

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

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

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

47 ;;; this group

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

72 ;;; change the reference link with completion.

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

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

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

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

77 ;;; is "netscape")

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

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

80 ;;;

81 ;;;[キーの説明]

82 ;;;

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

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

85 ;;;

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

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

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

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

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

91 ;;; できます。

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

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

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

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

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

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

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

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

100 ;;; を行います。

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

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

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

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

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

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

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

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

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

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

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

112 ;;; す。

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

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

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

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

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

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

119 ;;; きます。

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

121 ;;; す。

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

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

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

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

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

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

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

129 ;;;

130 ;;; [謝辞]

131 ;;;

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

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

134 ;;;

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

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

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

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

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

140 ;;;

141

142

143 ;(require 'yatex)

144 (require 'yatexlib)

145 ;;; --- customizable variable starts here ---

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

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

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

149 (defvar yahtml-www-browser "netscape"

150 "*WWW Browser command")

151 (defvar yahtml-kanji-code 2

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

153 (defvar yahtml-coding-system

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

155 "Kanji coding system")

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

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

158

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

160 (defvar yahtml-path-url-alist nil

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

162 Ex.

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

164 (\"/usr/home/yuuji/darts/http\" . \"http://darts.comp.ae.keio.ac.jp/~darts\"))")

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

166 "*Directory index file name;

167 Consult your site's WWW administrator.")

168

169 (defvar yahtml-environment-indent 1

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

171

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

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

174

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

176 "*Program name to lint HTML file")

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

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

179

180 (defvar yahtml-always-/p nil

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

182

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

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

185

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

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

188

189 ;;; --- customizable variable ends here ---

190 (defvar yahtml-prefix-map nil)

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

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

193 (defvar yahtml-shell-command-option

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

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

196

197

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

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

200 (YaTeX-define-key

201 key

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

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

204 map))

205

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

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

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

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

210

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

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

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

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

215 (if YaTeX-inhibit-prefix-letter nil

216 (yahtml-define-begend-region-key

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

218

219

220 (if yahtml-mode-map nil

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

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

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

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

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

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

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

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

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

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

231 (let ((map yahtml-prefix-map))

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

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

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

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

236 (and YaTeX-emacs-19 window-system

237 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

252 (if YaTeX-no-begend-shortcut

253 (progn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

272 )

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

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

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

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

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

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

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

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

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

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

283 ))

284

285 (if yahtml-lint-buffer-map nil

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

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

288

289

290 (defvar yahtml-paragraph-start

291 (concat

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

293 "*Regexp of html paragraph separater")

294 (defvar yahtml-paragraph-separate

295 (concat

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

297 "*Regexp of html paragraph separater")

298 (defvar yahtml-syntax-table nil

299 "*Syntax table for yahtml-mode")

300

301 (if yahtml-syntax-table nil

302 (setq yahtml-syntax-table

303 (make-syntax-table (standard-syntax-table)))

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

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

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

307 )

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

309 "Regexp of constituent of html commands.")

310

311 ;;; Completion tables for `form'

312 (defvar yahtml-form-table

313 '(("img") ("input")))

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

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

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

317

318 (defvar yahtml-env-table

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

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

321 ("OrderedList" . "ol")

322 ("UnorderedList" . "ul")

323 ("DefinitionList" . "dl")

324 ("Preformatted" . "pre")

325 ("table") ("tr") ("th") ("td")

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

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

328 ))

329

330 (defvar yahtml-itemizing-regexp

331 "\$ul\\|ul\\|dl\$"

332 "Regexp of itemizing forms")

333

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

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

336

337 ;;; Completion tables for typeface designator

338 (and yahtml-always-/p

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

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

341

342 (defvar yahtml-typeface-table

343 (append

344 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp") ("strike")

345 ("strong") ("var") ("b") ("i") ("tt") ("u") ("address") ("font"))

346 yahtml-env-table)

347 "Default completion table of typeface designator")

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

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

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

351

352 (defvar yahtml-single-cmd-table

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

354 ("HorizontalLine" . "hr")

355 ("BreakLine" . "br")

356 ("Paragraph" . "p")

357 ("Item" . "li")

358 ("DefineTerm" . "dt")

359 ("Description" . "dd")

360 ("dd") ("dt") ("li")

361 )

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

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

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

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

366

367 (defvar yahtml-prefer-upcases nil)

368

369 ;(defvar yahtml-struct-name-regexp

371 (defvar yahtml-struct-name-regexp

372 (concat

373 "\\<\\("

374 (mapconcat (function (lambda (x) (car x))) yahtml-typeface-table "\\|")

375 "\\)\\b")

376 "Regexp of structure beginning.")

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

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

379

380 (defun yahtml-mode ()

381 (interactive)

382 (cond

383 ((and YaTeX-emacs-20 (fboundp 'coding-system-equal))

384 (let ((mp (buffer-modified-p))

385 (ud (memq buffer-file-coding-system

386 '(undecided undecided-unix undecided-dos undecided-mac))))

387 (if (coding-system-equal

388 yahtml-coding-system buffer-file-coding-system)

389 nil ; if coding-system is the same, do nothing

390 (set-buffer-file-coding-system yahtml-coding-system)

391 (if ud (set-buffer-modified-p mp)))))

392 ((featurep 'mule)

393 (set-file-coding-system yahtml-coding-system))

394 ((boundp 'NEMACS)

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

396 (setq kanji-fileio-code yahtml-kanji-code)))

397 (setq major-mode 'yahtml-mode

398 mode-name "yahtml")

399 (mapcar

400 (function (lambda (x)

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

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

403 (boundp (cdr x)))

404 (symbol-value (cdr x))

405 (cdr x)))))

406 '((YaTeX-ec . "")

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

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

409 (YaTeX-struct-name-regexp . yahtml-struct-name-regexp)

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

411 (YaTeX-coding-system . yahtml-coding-system)

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

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

414 (paragraph-start . yahtml-paragraph-start)

415 (paragraph-separate . yahtml-paragraph-separate)

416 (comment-start . "")

417 (comment-start-skip . comment-start)

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

419

420 (set-syntax-table yahtml-syntax-table)

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

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

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

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

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

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

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

428

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

430 (cond

431 ((featurep 'xemacs)

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

433 (set keymap nil)

434 (mapcar

435 (function

436 (lambda (bind)

437 (setq bind (cdr bind))

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

439 (setcar (cdr bind) 'progn))

440 (if (stringp (car (cdr bind)))

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

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

443 (symbol-value keymap))))))

444 bindlist)

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

446 (t

447 (mapcar

448 (function

449 (lambda (bind)

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

451 bindlist))))

452

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

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

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

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

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

458

459 ;;; Variables for mosaic url history

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

461 (defvar yahtml-urls-private nil)

462 (defvar yahtml-urls-local nil)

463

464 (cond

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

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

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

468 (YaTeX-define-menu

469 'yahtml-menu-map-sectioning

470 (nreverse

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

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

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

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

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

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

477 )))

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

479 (YaTeX-define-menu

480 'yahtml-menu-map-logical

481 (nreverse

482 '((em "Embolden" .

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

484 (dfn "Define a word" .

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

486 (cite "Citation" .

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

488 (code "Code" .

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

490 (kbd "Keyboard" .

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

492 (samp "Sample display" .

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

494 (strong "Strong" .

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

496 (VAR "Variable notation" .

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

498 )))

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

500 (YaTeX-define-menu

501 'yahtml-menu-map-typeface

502 (nreverse

503 '((b "Bold" .

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

505 (i "Italic" .

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

507 (tt "Typewriter" .

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

509 (u "Underlined" .

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

511 )))

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

513 (YaTeX-define-menu

514 'yahtml-menu-map-listing

515 (nreverse

516 '((ul "Unordered" .

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

518 (ol "Ordered" .

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

520 (dl "Definition" .

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

522 )))

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

524 (YaTeX-define-menu

525 'yahtml-menu-map-item

526 (nreverse

527 '((li "Simple item" .

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

529 (dt "Define term" .

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

531 (dd "Description of term" .

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

533 )))

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

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

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

537 (while keys

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

539 (setq keys (cdr keys))))

540 (YaTeX-define-menu

541 'yahtml-menu-map

542 (nreverse

543 (list

544 (cons (list 'sect "Sectioning")

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

546 (cons (list 'list "Listing")

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

548 (cons (list 'item "Item")

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

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

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

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

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

554 )))

555 (if (featurep 'xemacs)

556 (add-hook 'yahtml-mode-hook

557 '(lambda ()

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

559 (progn

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

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

562 ))

563

564 ;;; ----------- Completion ----------

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

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

567 "Insert <cmd> ... </cmd>."

568 (interactive "P")

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

570 (cmd

571 (or env

572 (YaTeX-cplread-with-learning

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

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

575 (bolp (save-excursion

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

577 (cc (current-column)))

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

579 (setq yahtml-last-begend

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

581 yahtml-last-begend))

582 (setq cmd yahtml-last-begend)

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

584 (if region

585 (let ((beg (region-beginning))

586 (end (region-end))

587 (addin (yahtml-addin cmd)))

588 (goto-char end)

589 (insert (format "</%s>%s" cmd (if bolp "\n" "")))

590 (goto-char beg)

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

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

593 (save-excursion

594 (insert "\n")

595 (indent-to-column cc)

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

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

598 (newline)

599 (yahtml-intelligent-newline nil))

600 (yahtml-indent-line))))

601

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

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

604 (interactive)

605 (yahtml-insert-begend t))

606

607

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

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

610 (interactive)

611 (or form

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

613 (setq form

614 (YaTeX-cplread-with-learning

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

616 'yahtml-form-table 'yahtml-user-form-table

617 'yahtml-tmp-form-table))))

618 (let ((p (point)) q)

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

620 (setq yahtml-last-form form)

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

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

623 ;;(indent-relative-maybe)

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

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

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

627

628 ;;; ---------- Add-in ----------

629 (defun yahtml-addin (form)

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

631 (let ((addin (concat "yahtml:" (downcase form))) s)

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

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

634 (string< "" s))

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

636 "")))

637

638

639 (defvar yahtml-completing-buffer nil)

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

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

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

643 (let (list bound)

644 (save-excursion

645 (set-buffer yahtml-completing-buffer)

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

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

648 (save-excursion

649 (goto-char (point-min))

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

651 (setq bound (match-end 0))

652 (search-forward ">" nil t)

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

654 (progn

655 (goto-char (match-end 0))

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

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

658 (setq list (cons

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

660 list))))

661 list)))

662 )

663

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

665 (if yahtml-url-completion-map nil

666 (setq yahtml-url-completion-map

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

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

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

670 )

671

672 (defun yahtml-complete-url ()

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

674 (interactive)

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

676 (setq initial (buffer-string))

677 (cond

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

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

680 listfunc (list 'lambda nil

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

682 beg (point-min)))

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

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

685 (progn

686 (setq path (substring initial 0 beg))

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

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

689 (setq initial (substring initial beg))

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

691 cmpl (try-completion initial labels)

692 listfunc (list 'lambda ()

693 (list 'all-completions

694 initial (list 'quote labels)))

695 beg (+ (point-min) beg)))

696 (t

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

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

699 initial))

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

701 file (file-name-nondirectory path)

702 initial file

703 cmpl (file-name-completion file dir)

704 listfunc (list 'lambda nil

705 (list 'file-name-all-completions

706 file dir))

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

708 (cond

709 ((stringp cmpl)

710 (if (string= initial cmpl)

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

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

713 (princ

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

715 (delete-region (point) beg)

716 (insert cmpl)))

717 ((null cmpl)

718 (ding))

719 ((eq t cmpl)

720 (save-excursion

721 (unwind-protect

722 (progn

723 (goto-char p)

724 (insert " [Sole completion]"))

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

726

727 (defun yahtml:a ()

728 "Add-in function for <a>"

729 (let ((href ""))

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

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

732 ;; yahtml-urls-local is buffer-local, so we must put

733 ;; that into yahtml-urls here

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

735 (prog1

736 (concat (yahtml-make-optional-argument

737 "href" href)

738 (yahtml-make-optional-argument

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

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

741 (null (assoc href yahtml-urls)))

742 (YaTeX-update-table

743 (list href)

744 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))

745 )))

746

747 (defvar yahtml-parameters-completion-alist

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

749 ("src" . file)

750 ("method" ("POST") ("GET"))))

751

752 (defun yahtml-read-parameter (par)

753 (let* ((alist (cdr-safe (assoc (downcase par)

754 yahtml-parameters-completion-alist)))

755 (prompt (concat par ": "))

756 v)

757 (cond

758 ((eq alist 'file)

759 (read-file-name prompt "" nil nil ""))

760 (alist

761 (completing-read prompt alist))

762 (t

763 (read-string prompt)))))

764

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

766 "Make optional argument string."

767 (if (string= "" arg)

768 ""

769 (concat " " (if yahtml-prefer-upcases (upcase opt) (downcase opt))

770 "=\"" arg "\"")))

771

772 (defun yahtml:body ()

773 "Add-in function for <body>"

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

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

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

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

778 (concat

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

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

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

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

783

784

785 (defun yahtml:img ()

786 "Add-in function for <img>"

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

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

789 (alt (yahtml-read-parameter "alt"))

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

791 (l yahtml-prefer-upcases))

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

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

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

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

796

797 (defun yahtml:form ()

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

799 (concat

800 " " (if yahtml-prefer-upcases "METHOD" "method=")

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

802 " " (if yahtml-prefer-upcases "ACTION" "action") "=\""

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

804 ))

805

806 (defun yahtml:select ()

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

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

809 (concat " " (if yahtml-prefer-upcases "NAME" "name") "=\""

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

811

812 (defun yahtml:ol ()

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

814 (defun yahtml:ul ()

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

816 (defun yahtml:dl ()

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

818 (defun yahtml:dt ()

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

820

821 (defun yahtml:p ()

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

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

824 ))

825

826 (defvar yahtml-input-types

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

828 ("reset") ("image") ("hidden") ("file")))

829

830 (defun yahtml:input ()

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

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

833 (l yahtml-prefer-upcases))

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

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

836 yahtml-input-types nil t)

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

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

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

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

841 (concat

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

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

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

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

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

847 )))

848

849 (defun yahtml:textarea ()

850 "Add-in function for `textarea'"

851 (interactive)

852 (let (name rows cols)

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

854 cols (read-string "Columns: ")

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

856 (concat

857 (concat (if yahtml-prefer-upcases "NAME=" "name=")

858 "\"" name "\"")

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

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

861

862 (defun yahtml:table ()

863 "Add-in function for `table'"

864 (yahtml-make-optional-argument "border" (read-string "border=")))

865

866 (defun yahtml:font ()

867 "Add-in function for `font'"

868 (concat

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

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

871

872 ;;; ---------- Simple tag ----------

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

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

875 (interactive "P")

876 (or tag

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

878 (setq tag

879 (YaTeX-cplread-with-learning

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

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

882 'yahtml-typeface-table 'yahtml-user-typeface-table

883 'yahtml-tmp-typeface-table))))

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

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

886 (setq yahtml-last-typeface-cmd tag

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

888 (if region-mode

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

890 (save-excursion

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

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

893 (exchange-point-and-mark)

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

895 (message "No mark set now"))

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

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

898

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

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

901 (interactive)

902 (yahtml-insert-tag t tag))

903

904

905 (defun yahtml-insert-single (cmd)

906 "Insert <CMD>."

907 (interactive

908 (list

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

910 (YaTeX-cplread-with-learning

911 (format "Command%s: "

912 (if yahtml-last-single-cmd

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

914 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table

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

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

917 (setq yahtml-last-single-cmd

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

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

920 yahtml-last-single-cmd))

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

922

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

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

925 (interactive "P")

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

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

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

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

930

931 ;;; ---------- Jump ----------

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

933 "Check if point is on href clause."

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

935 (save-excursion

936 (and (string= (YaTeX-inner-environment t) "a")

937 (save-excursion

938 (search-forward "</a>" nil t)

939 (setq e (point)))

940 (goto-char (get 'YaTeX-inner-environment 'point))

941 (search-forward "href" e t)

942 (search-forward "=" e t)

943 (progn

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

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

946 (< p (match-end 0))

947 (YaTeX-match-string 1)

948 ))))

949

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

951 (cond

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

953 (set-process-buffer proc nil))

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

955 (let ((cb (current-buffer)))

956 (set-buffer (process-buffer proc))

957 (goto-char (point-min))

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

959 (progn

960 (message "Starting netscape...")

961 (start-process

962 "browser" (process-buffer proc)

963 shell-file-name yahtml-shell-command-option

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

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

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

967 (set-buffer cb)))))

968

969 (defvar yahtml-browser-process nil)

970

971 (defun yahtml-browse-html (href)

972 "Call WWW Browser to see HREF."

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

974 (cond

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

976 (if (get-buffer pb)

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

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

979 (set-process-sentinel

980 (setq yahtml-browser-process

981 (start-process

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

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

984 'yahtml-netscape-sentinel))

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

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

987 (if (get-buffer pb)

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

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

990 (set-process-sentinel

991 (setq yahtml-browser-process

992 (start-process

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

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

995 'yahtml-netscape-sentinel))

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

997 (w3-fetch href))

998 ((stringp yahtml-www-browser)

999 (if (and yahtml-browser-process

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

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

1002 (setq yahtml-browser-process

1003 (start-process

1004 "browser" "* WWW Browser *"

1005 shell-file-name yahtml-shell-command-option

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

1007 (t

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

1009

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

1011 "Go to corresponding name."

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

1013 (if href

1014 (cond

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

1016 (yahtml-browse-html href))

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

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

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

1020 (if (string< "" file)

1021 (progn

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

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

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

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

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

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

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

1029 (if name

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

1031 t)))))

1032

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

1034 "Jump to html's named tag."

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

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

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

1038 (message "Named tag `%s' not found" (substring href 1))))

1039

1040 (defun yahtml-on-begend-p (&optional p)

1041 "Check if point is on begend clause."

1042 (let ((p (or p (point))) cmd (case-fold-search t))

1043 (save-excursion

1044 (goto-char p)

1045 (if (equal (char-after (point)) ?<) (forward-char 1))

1046 (if (and (re-search-backward "<" nil t)

1047 (looking-at

1048 (concat "<\$/?" yahtml-struct-name-regexp "\$\\b"))

1049 (condition-case nil

1050 (forward-list 1)

1051 (error nil))

1052 (< p (point)))

1053 (YaTeX-match-string 1)))))

1054

1055 (defun yahtml-goto-corresponding-begend (&optional noerr)

1056 "Go to corresponding opening/closing tag.

1057 Optional argument NOERR causes no error for unballanced tag."

1058 (let ((cmd (yahtml-on-begend-p)) m0

1059 (p (point)) (case-fold-search t) func str (nest 0))

1060 (cond

1061 (cmd

1062 (setq m0 (match-beginning 0))

1063 (if (= (aref cmd 0) ?/) ;on </cmd> line

1064 (setq cmd (substring cmd 1)

1065 str (format "\$<%s\$\\|\$</%s\$" cmd cmd)

1066 func 're-search-backward)

1067 (setq str (format "\$</%s\$\\|\$<%s\$" cmd cmd)

1068 func 're-search-forward))

1069 (while (and (>= nest 0) (funcall func str nil t))

1070 (if (equal m0 (match-beginning 0))

1071 nil

1072 (setq nest (+ nest (if (match-beginning 1) -1 1)))))

1073 (if (< nest 0)

1074 (goto-char (match-beginning 0))

1075 (funcall

1076 (if noerr 'message 'error)

1077 "Corresponding tag of `%s' not found." cmd)

1078 (goto-char p)

1079 nil))

1080 (t nil))))

1081

1082 (defun yahtml-current-tag ()

1083 "Return the current tag name."

1084 (save-excursion

1085 (let ((p (point)) b tag)

1086 (or (bobp)

1087 (looking-at "<")

1088 (progn (skip-chars-backward "^<") (forward-char -1)))

1089 (setq b (point))

1090 (skip-chars-forward "<")

1091 (setq tag (buffer-substring

1092 (point) (progn (skip-chars-forward "^ \t\n") (point))))

1093 (goto-char b)

1094 (forward-list 1)

1095 (and (< p (point)) tag))))

1096

1097

1098 (defun yahtml-goto-corresponding-img ()

1099 "View image on point"

1100 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))

1101 (if (and tag

1102 (string-match "img" tag)

1103 (save-excursion

1104 (re-search-backward "<\\s *img" nil t)

1105 (re-search-forward "src=\"?\$[^\"> ]+\$\"?")

1106 (match-beginning 1)

1107 (setq image

1108 (buffer-substring (match-beginning 1) (match-end 1)))))

1109 (progn

1110 (message "Invoking %s %s..." yahtml-image-viewer image)

1111 (start-process

1112 "Viewer" " * Image Viewer *"

1113 shell-file-name yahtml-shell-command-option ;"-c"

1114 (concat yahtml-image-viewer " " image))

1115 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))

1116

1117 (defun yahtml-get-attrvalue (attr)

1118 "Extract current tag's attribute value from buffer."

1119 (let (e (case-fold-search t))

1120 (save-excursion

1121 (or (looking-at "<")

1122 (progn (skip-chars-backward "^<") (backward-char 1)))

1123 (setq e (save-excursion (forward-list 1) (point)))

1124 (if (and

1125 (re-search-forward (concat "\\b" attr "\\b") e t)

1126 (progn (skip-chars-forward " \t\n=")

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

1128 (YaTeX-match-string 1)))))

1129

1130 (defun yahtml-goto-corresponding-source (&optional other)

1131 "Goto applet's source."

1132 (let ((env (yahtml-current-tag)) s (p (point)))

1133 (cond

1134 ((string-match "applet" env)

1135 (if (setq s (yahtml-get-attrvalue "code"))

1136 (progn

1137 (setq s (YaTeX-match-string 1)

1138 s (concat

1139 (substring s 0 (string-match "\\.[A-Za-z]+$" s))

1140 ".java"))

1141 (if other (YaTeX-switch-to-buffer-other-window s)

1142 (YaTeX-switch-to-buffer s))

1143 s) ;return source file name

1144 (message "No applet source specified")

1145 (sit-for 1)

1146 nil))

1147 ((string-match "!--#include" env)

1148 (cond

1149 ((setq s (yahtml-get-attrvalue "file")) ;

1150 (if other (YaTeX-switch-to-buffer-other-window s)

1151 (YaTeX-switch-to-buffer s))

1152 s)

1153 ((setq s (yahtml-get-attrvalue "virtual"));

1154 (setq s (yahtml-url-to-path s))

1155 (if other (YaTeX-switch-to-buffer-other-window s)

1156 (YaTeX-switch-to-buffer s))

1157 s)))

1158 ((and (string-match "!--#exec" env)

1159 (setq s (yahtml-get-attrvalue "cmd")))

1160 (setq s (substring s 0 (string-match " \t\\?" s))) ;get argv0

1161 (let ((b " *yahtmltmp*")) ;peek a little

1162 (unwind-protect

1163 (progn

1164 (set-buffer (get-buffer-create b))

1165 (insert-file-contents s nil 0 100)

1166 (if (looking-at "#!")

1167 (if other (YaTeX-switch-to-buffer-other-window s)

1168 (YaTeX-switch-to-buffer s))))

1169 (kill-buffer (get-buffer b)))

1170 (get-file-buffer s))))))

1171

1172 (defun yahtml-goto-corresponding-* (&optional other)

1173 "Go to corresponding object."

1174 (interactive)

1175 (cond

1176 ((yahtml-goto-corresponding-href other))

1177 ((yahtml-goto-corresponding-img))

1178 ((yahtml-goto-corresponding-begend))

1179 ((yahtml-goto-corresponding-source other))

1180 (t (message "I don't know where to go."))

1181 ))

1182

1183 (defun yahtml-goto-corresponding-*-other-window ()

1184 "Go to corresponding object."

1185 (interactive)

1186 (yahtml-goto-corresponding-* t))

1187

1188 (defun yahtml-visit-main ()

1189 "Go to parent file from where you visit current file."

1190 (interactive)

1191 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))

1192

1193 ;;; ---------- killing ----------

1194 (defun yahtml-kill-begend (&optional whole)

1195 (let ((tag (yahtml-on-begend-p)) p q r bbolp)

1196 (if tag

1197 (save-excursion

1198 (or (looking-at "<")

1199 (progn (skip-chars-backward "^<") (forward-char -1)))

1200 (setq p (point))

1201 (yahtml-goto-corresponding-begend)

1202 (or (looking-at "<")

1203 (progn (skip-chars-backward "^<") (forward-char -1)))

1204 (if (< (point) p) ;if on the opening tag

1205 (progn (setq q p p (point))

1206 (goto-char q))

1207 (setq q (point))) ;now q has end-line's (point)

1208 (if (not whole)

1209 (kill-region

1210 (progn (skip-chars-backward " \t")

1211 (if (setq bbolp (bolp)) (point) q))

1212 (progn (forward-list 1)

1213 (setq r (point))

1214 (skip-chars-forward " \t")

1215 (if (and bbolp (eolp) (not (eobp))) (1+ (point)) r))))

1216 (goto-char p)

1217 (skip-chars-backward " \t")

1218 (if (not whole)

1219 (progn

1220 (kill-append

1221 (buffer-substring

1222 (setq p (if (setq bbolp (bolp)) (point) p))

1223 (setq q (progn

1224 (forward-list 1)

1225 (setq r (point))

1226 (skip-chars-forward " \t")

1227 (if (and bbolp (eolp) (not (eobp)))

1228 (1+ (point))

1229 r))))

1230 t)

1231 (delete-region p q))

1232 (kill-region

1233 (if (bolp) (point) p)

1234 (progn (goto-char q)

1235 (forward-list 1)

1236 (setq r (point))

1237 (skip-chars-forward " \t")

1238 (if (and (eolp) (not (eobp))) (1+ (point)) r))))

1239 tag))))

1240

1241 (defun yahtml-kill-* (whole)

1242 "Kill current position's HTML tag (set)."

1243 (interactive "P")

1244 (cond

1245 ((yahtml-kill-begend whole))

1246 ))

1247

1248

1249 ;;; ---------- changing ----------

1250 (defun yahtml-on-assignment-p ()

1251 "Return if current point is on parameter assignment.

1252 If so, return parameter name, otherwise nil.

1253 This function should be able to treat white spaces in value, but not yet."

1254 (let ((p (point)))

1255 (save-excursion

1256 (put 'yahtml-on-assignment-p 'region nil)

1257 (skip-chars-backward "^ \t")

1258 (and (looking-at "\$[A-Za-z0-9]+\$\\s *=\\s *\"?\$[^ \t\"]+\$\"?")

1259 (< p (match-end 0))

1260 (>= p (1- (match-beginning 2)))

1261 (put 'yahtml-on-assignment-p 'region

1262 (cons (match-beginning 2) (match-end 2)))

1263 (YaTeX-match-string 1)))))

1264

1265 (defun yahtml-change-begend ()

1266 (let ((tag (yahtml-on-begend-p))

1267 (completion-ignore-case t)

1268 (case-fold-search t)

1269 (p (point)) (q (make-marker))

1270 (default (append yahtml-env-table yahtml-typeface-table))

1271 (user (append yahtml-user-env-table yahtml-user-typeface-table))

1272 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))

1273 href b1 e1)

1274 (cond

1275 (tag

1276 (cond

1277 ((and (string-match "^a$" tag)

1278 (save-excursion

1279 (and

1280 (re-search-backward "<a\\b" nil t)

1281 (progn

1282 (goto-char (match-end 0))

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

1284 (setq b1 (point))

1285 (search-forward ">" nil t))

1286 (setq e1 (match-beginning 0))

1287 (goto-char b1)

1288 (re-search-forward "href\\s *=" e1 t)

1289 (>= p (point))

1290 (progn

1291 (goto-char (match-end 0))

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

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

1294 (< p (match-end 0)))))

1295 (setq b1 (match-beginning 1) e1 (match-end 1)

1296 yahtml-completing-buffer (current-buffer)

1297 ;; yahtml-urls-local is buffer-local, so we must put

1298 ;; that into yahtml-urls here

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

1300 href (read-from-minibuffer

1301 "Change href to: " "" yahtml-url-completion-map))

1302 (if (string< "" href)

1303 (progn

1304 ;;(setq href ;??

1305 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))

1306 (delete-region b1 e1)

1307 (goto-char b1)

1308 (insert href))))

1309 (t

1310 (save-excursion

1311 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))

1312 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))

1313 (skip-chars-forward "^A-Za-z")

1314 (set-marker q (point))

1315 (setq p (point))

1316 (yahtml-goto-corresponding-begend)

1317 (or (= (char-after (point)) ?<)

1318 (skip-chars-backward "^<"))

1319 (skip-chars-forward "^A-Za-z")

1320 (if (= (char-after (1- (point))) ?/)

1321 (progn

1322 (set-marker q (point))

1323 (goto-char p)))

1324 (setq tag (let ((completion-ignore-case t))

1325 (YaTeX-cplread-with-learning

1326 (format "Change `%s' to(default %s): "

1327 tag yahtml-last-begend)

1328 'default 'user 'tmp)))

1329 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1330 (if (string= "" tag) (setq tag yahtml-last-begend))

1331 (setq yahtml-last-begend

1332 (or (cdr (assoc tag yahtml-env-table)) tag)

1333 tag yahtml-last-begend)

1334 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))

1335 (insert (format "%s%s" tag (yahtml-addin tag)))

1336 (goto-char q)

1337 (set-marker q nil)

1338 (delete-region (point) (progn (skip-chars-forward "^>") (point)))

1339 (insert tag))))

1340 t))))

1341

1342 (defun yahtml-change-command ()

1343 (let ((p (point)) (case-fold-search t) cmd par new

1344 (beg (make-marker)) (end (make-marker)))

1345 (skip-chars-backward "^<")

1346 (if (and

1347 (looking-at yahtml-command-regexp)

1348 (progn

1349 (set-marker beg (match-beginning 0))

1350 (set-marker end (match-end 0))

1351 t) ;for further work

1352 (progn

1353 (forward-char -1)

1354 (condition-case nil

1355 (forward-list 1)

1356 (error nil))

1357 (< p (point))))

1358 (progn

1359 (goto-char p)

1360 (if (setq par (yahtml-on-assignment-p))

1361 (progn

1362 (setq new (yahtml-read-parameter par))

1363 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))

1364 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))

1365 (setq new

1366 (YaTeX-cplread-with-learning

1367 "Change form to: "

1368 'yahtml-form-table 'yahtml-user-form-table

1369 'yahtml-tmp-form-table)))

1370 (delete-region beg end)

1371 (goto-char beg)

1372 (set-marker beg nil)

1373 (set-marker end nil)

1374 (insert new)

1375 t)

1376 (goto-char p)

1377 nil)))

1378

1379 (defun yahtml-change-* ()

1380 "Change current position's HTML tag (set)."

1381 (interactive)

1382 (cond

1383 ((yahtml-change-begend))

1384 ((yahtml-change-command))

1385 ))

1386

1387 ;;; ---------- commenting ----------

1388 (defun yahtml-comment-region (&optional uncom)

1389 "Comment out region or environment."

1390 (interactive)

1391 (let (e beg p)

1392 (cond

1393 ((setq e (yahtml-on-begend-p))

1394 (save-excursion

1395 (setq p (point))

1396 (if (string-match "^/" e)

1397 (setq beg (progn (forward-line 1) (point)))

1398 (setq beg (progn (beginning-of-line) (point))))

1399 (goto-char p)

1400 (yahtml-goto-corresponding-begend)

1401 (if (string-match "^/" e)

1402 (beginning-of-line)

1403 (forward-line 1))

1404 (comment-region beg (point) (if uncom (list 4)))))

1405 (t (comment-region (region-beginning) (region-end)

1406 (if uncom (list 4)))))))

1407

1408 (defun yahtml-uncomment-region ()

1409 (interactive)

1410 (yahtml-comment-region t))

1411

1412

1413

1414 (defun yahtml-inner-environment-but (exclude &optional quick)

1415 "Return the inner environment but matches with EXCLUDE tag."

1416 (let (e (case-fold-search t))

1417 (save-excursion

1418 (while (and (setq e (YaTeX-inner-environment quick))

1419 (string-match exclude e))

1420 (goto-char (get 'YaTeX-inner-environment 'point))))

1421 e))

1422

1423 ;;; ---------- filling ----------

1424

1425 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))

1426 (defun yahtml-move-to-column (col &optional force)

1427 (beginning-of-line)

1428 (let ((ccol 0))

1429 (while (and (> col ccol) (not (eolp)))

1430 (if (eq (following-char) ?\<)

1431 (progn

1432 (while (and (not (eq (following-char) ?\>))

1433 (not (eolp)))

1434 (forward-char))

1435 (or (eolp) (forward-char)))

1436 (or (eolp) (forward-char))

1437 (if (eq (preceding-char) ?\t)

1438 (let ((wd (- 8 (% (+ ccol 8) 8))))

1439 (if (and force (< col (+ ccol wd)))

1440 (progn

1441 (backward-char 1)

1442 (insert-char ?\ (- col ccol))

1443 (setq ccol col))

1444 (setq ccol (+ ccol wd))))

1445 (setq ccol (1+ ccol)))

1446 (if (and YaTeX-japan

1447 (string-match "[chj]" (char-category (preceding-char))))

1448 (setq ccol (1+ ccol)))))

1449 (if (and force (> col ccol))

1450 (progn

1451 (insert-char ?\ (- col ccol))

1452 col)

1453 ccol)))

1454

1455 (defun yahtml-fill-paragraph (arg)

1456 (interactive "P")

1457 (let*((case-fold-search t) (p (point)) fill-prefix

1458 (e (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t) "html"))

1459 indent

1460 (startp (get 'YaTeX-inner-environment 'point))

1461 (prep (string-match "^pre$" e))

1462 (ps1 (if prep (default-value 'paragraph-start)

1463 paragraph-start))

1464 (ps2 (if prep (concat (default-value 'paragraph-start)

1465 "\\|^\\s *</?pre>")

1466 paragraph-start)))

1467 (save-excursion

1468 (unwind-protect

1469 (progn

1470 (if prep

1471 (fset 'move-to-column 'yahtml-move-to-column))

1472 (save-excursion

1473 (beginning-of-line)

1474 (indent-to-column (yahtml-this-indent))

1475 (setq fill-prefix

1476 (buffer-substring (point) (point-beginning-of-line)))

1477 (delete-region (point) (point-beginning-of-line)))

1478 (fill-region-as-paragraph

1479 (progn (re-search-backward paragraph-start nil t)

1480 (or (save-excursion

1481 (goto-char (match-beginning 0))

1482 (if (looking-at "<")

1483 (forward-list)

1484 (goto-char (match-end 0))

1485 (skip-chars-forward " \t>"))

1486 (if (looking-at "[ \t]*$")

1487 (progn (forward-line 1) (point))))

1488 (point)))

1489 (progn (goto-char p)

1490 (re-search-forward ps2 nil t)

1491 (match-beginning 0)

1492

1493 )))

1494 (fset 'move-to-column yahtml-saved-move-to-column)))))

1495

1496 ;(defun yahtml-indent-new-commnet-line ()

1497 ; (unwind-protect

1498 ; (progn

1499 ; (fset 'move-to-column 'yahtml-move-to-column)

1500 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))

1501 ; (fset 'move-to-column yahtml-saved-move-to-column)))

1502

1503 ;;;

1504 ;;; ---------- indentation ----------

1505 ;;;

1506 (defun yahtml-indent-line ()

1507 "Indent a line (faster wrapper)"

1508 (interactive)

1509 (let (indent)

1510 (if (and (save-excursion

1511 (beginning-of-line) (skip-chars-forward "\t ")

1512 (not (looking-at "<")))

1513 (save-excursion

1514 (forward-line -1)

1515 (while (and (not (bobp)) (looking-at "^\\s *$"))

1516 (forward-line -1))

1517 (skip-chars-forward "\t ")

1518 (setq indent (current-column))

1519 (not (looking-at "<"))))

1520 (progn

1521 (save-excursion

1522 (beginning-of-line)

1523 (skip-chars-forward " \t")

1524 (or (= (current-column) indent)

1525 (YaTeX-reindent indent)))

1526 (and (bolp) (skip-chars-forward " \t")))

1527 (yahtml-indent-line-real))))

1528

1529 (defun yahtml-this-indent ()

1531 (itemizing-envs "^\$[uod]l\\|menu\\|dir\$$")

1532 (itms "<\$dt\\|dd\\|li\\|t[rdh]\\|option\$\\b")

1533 inenv p col peol (case-fold-search t))

1534 (save-excursion

1535 (beginning-of-line)

1536 (setq inenv (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

1537 "html")

1538 col (get 'YaTeX-inner-environment 'indent)

1539 p (get 'YaTeX-inner-environment 'point)

1540 op nil))

1541 (save-excursion

1542 (cond

1543 ((string-match envs inenv)

1544 (save-excursion

1545 (beginning-of-line)

1546 (skip-chars-forward " \t")

1547 (cond ;lookup current line's tag

1548 ((looking-at (concat "</\$" envs "\$>"))

1549 col)

1550 ((looking-at itms)

1551 (+ col yahtml-environment-indent))

1552 ((and yahtml-hate-too-deep-indentation

1553 (looking-at (concat "<\$" envs "\$")))

1554 (+ col (* 2 yahtml-environment-indent)))

1555 ((and (< p (point))

1556 (string-match itemizing-envs inenv)

1557 (save-excursion

1558 (and

1559 (setq op (point))

1560 (goto-char p)

1561 (re-search-forward itms op t)

1562 (progn

1563 (skip-chars-forward "^>")

1564 (skip-chars-forward ">")

1565 (skip-chars-forward " \t")

1566 (setq col (if (looking-at "$")

1567 (+ col yahtml-environment-indent)

1568 (current-column)))))))

1569 col)

1570 (t

1571 (+ col yahtml-environment-indent)))))

1572 (t col)))))

1573

1574 (defun yahtml-indent-line-real ()

1575 "Indent current line."

1576 (interactive)

1577 (YaTeX-reindent (yahtml-this-indent))

1578 (if (bolp) (skip-chars-forward " \t"))

1579 (let (peol col)

1580 (if (and (setq inenv (yahtml-on-begend-p))

1581 (string-match

1582 (concat "^\\<\$" yahtml-struct-name-regexp "\$") inenv))

1583 (save-excursion

1584 (setq peol (point-end-of-line))

1585 (or (= (char-after (point)) ?<)

1586 (progn (skip-chars-backward "^<") (forward-char -1)))

1587 (setq col (current-column))

1588 (if (and (yahtml-goto-corresponding-begend t)

1589 (> (point) peol)) ;if on the different line

1590 (YaTeX-reindent col))))))

1591

1592 ;(defun yahtml-fill-item ()

1593 ; "Fill item HTML version"

1594 ; (interactive)

1595 ; (let (inenv p fill-prefix peol (case-fold-search t))

1596 ; (setq inenv (or (YaTeX-inner-environment) "html")

1597 ; p (get 'YaTeX-inner-environment 'point))

1598 ; (cond

1599 ; ((string-match "^[uod]l" inenv)

1600 ; (save-excursion

1601 ; (if (re-search-backward "<\$d[td]\\|li\$>[ \t\n]*" p t)

1602 ; (progn

1603 ; (goto-char (match-end 0))

1604 ; (setq col (current-column)))

1605 ; (error "No <li>, <dt>, <dd>")))

1606 ; (save-excursion

1607 ; (end-of-line)

1608 ; (setq peol (point))

1609 ; (newline)

1610 ; (indent-to-column col)

1611 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))

1612 ; (delete-region (point) peol)

1613 ; (fill-region-as-paragraph

1614 ; (progn (re-search-backward paragraph-start nil t) (point))

1615 ; (progn (re-search-forward paragraph-start nil t 2)

1616 ; (match-beginning 0)))))

1617 ; (t nil))))

1618

1619 ;;;

1620 ;;; ---------- Lint and Browsing ----------

1621 ;;;

1622 (defun yahtml-browse-menu ()

1623 "Browsing menu"

1624 (interactive)

1625 (message "J)weblint p)Browse R)eload...")

1626 (let ((c (char-to-string (read-char))))

1627 (cond

1628 ((string-match "j" c)

1629 (yahtml-lint-buffer (current-buffer)))

1630 ((string-match "[bp]" c)

1631 (yahtml-browse-current-file))

1632 ((string-match "r" c)

1633 (yahtml-browse-reload)))))

1634

1635 (defvar yahtml-lint-buffer "*weblint*")

1636

1637 (defun yahtml-lint-buffer (buf)

1638 "Call lint on buffer BUF."

1639 (require 'yatexprc)

1640 (interactive "bCall lint on buffer: ")

1641 (setq buf (get-buffer buf))

1642 (YaTeX-save-buffers)

1643 (YaTeX-typeset

1644 (concat yahtml-lint-program " "

1645 (file-name-nondirectory (buffer-file-name buf)))

1646 yahtml-lint-buffer "lint" "lint"))

1647

1648 (defun yahtml-file-to-url (file)

1649 "Convert local unix file name to URL.

1650 If no matches found in yahtml-path-url-alist, return raw file name."

1651 (let ((list yahtml-path-url-alist) p url)

1652 (if (file-directory-p file)

1653 (setq file (expand-file-name yahtml-directory-index file))

1654 (setq file (expand-file-name file)))

1655 (if (string-match "^[A-Za-z]:/" file)

1656 (progn

1657 ;; (aset file 1 ?|) ;これは要らないらしい…

1658 (setq file (concat "///" file))))

1659 (while list

1660 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)

1661 (setq url (cdr (car list))

1662 file (substring file (match-end 0))

1663 url (concat url file)

1664 list nil))

1665 (setq list (cdr list)))

1666 (or url (concat "file:" file))))

1667

1668 (defun yahtml-url-to-path (file &optional basedir)

1669 "Convert local URL name to unix file name."

1670 (let ((list yahtml-path-url-alist) url realpath docroot

1671 (dirsufp (string-match "/$" file)))

1672 (setq basedir (or basedir

1673 (file-name-directory

1674 (expand-file-name default-directory))))

1675 (cond

1676 ((string-match "^/" file)

1677 (while list

1678 (if (file-directory-p (car (car list)))

1679 (progn

1680 (setq url (cdr (car list)))

1681 (if (string-match "\$http://[^/]*\$/" url)

1682 (setq docroot (substring url (match-end 1)))

1683 (setq docroot url))

1684 (cond

1685 ((string-match (concat "^" (regexp-quote docroot)) file)

1686 (setq realpath

1687 (expand-file-name

1688 (substring

1689 file

1690 (if (= (aref file (1- (match-end 0))) ?/)

1691 (match-end 0) ; "/foo"

1692 (min (1+ (match-end 0)) (length file)))) ; "/~foo"

1693 (car (car list))))))

1694 (if realpath

1695 (progn (setq list nil)

1696 (if (and dirsufp (not (string-match "/$" realpath)))

1697 (setq realpath (concat realpath "/")))))))

1698 (setq list (cdr list)))

1699 realpath)

1700 (t file))))

1701

1702 (defun yahtml-browse-current-file ()

1703 "Call WWW browser on current file."

1704 (interactive)

1705 (basic-save-buffer)

1706 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))

1707

1708 (defun yahtml-browse-reload ()

1709 "Send `reload' event to netzscape."

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

1711 (cond

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

1713 (if (get-buffer pb)

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

1715 ;;(or (get 'yahtml-netscape-sentinel 'url)

1716 ;; (error "Reload should be called after Browsing."))

1717 (put 'yahtml-netscape-sentinel 'url

1718 (yahtml-file-to-url (buffer-file-name)))

1719 (basic-save-buffer)

1720 (set-process-sentinel

1721 (setq yahtml-browser-process

1722 (start-process

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

1724 (format "%s -remote 'reload'" yahtml-www-browser)))

1725 'yahtml-netscape-sentinel))

1726 (t

1727 (message "Sorry, RELOAD is supported only for Netscape.")))))

1728

1729 ;;; ---------- Intelligent newline ----------

1730 (defun yahtml-intelligent-newline (arg)

1731 "Intelligent newline for HTML"

1732 (interactive "P")

1733 (let (env func)

1734 (end-of-line)

1735 (setq env (downcase (or (yahtml-inner-environment-but "^\$a\\|p\$\\b" t)

1736 "html")))

1737 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))

1738 (newline)

1739 (if (and env func (fboundp func))

1740 ;; if intelligent line function is defined, call that

1741 (funcall func)

1742 ;; else do the default action

1743 (if (string-match yahtml-p-prefered-env-regexp env)

1744 (yahtml-insert-p)))))

1745

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

1747 (defun yahtml-intelligent-newline-ul ()

1748 (interactive)

1749 (yahtml-insert-single "li")

1750 (or yahtml-faithful-to-htmllint (insert " "))

1751 (yahtml-indent-line))

1752

1753 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)

1754

1755 (defun yahtml-intelligent-newline-dl ()

1756 (interactive)

1757 (let ((case-fold-search t))

1758 (if (save-excursion

1759 (re-search-backward "<\$\\(dt\$\\|\$dd\$\\)>"

1760 (get 'YaTeX-inner-environment 'point) t))

1761 (cond

1762 ((match-beginning 2)

1763 (yahtml-insert-single "dd")

1764 (or yahtml-faithful-to-htmllint (insert " "))

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

1766 ((match-beginning 3)

1767 (yahtml-insert-single "dt")

1768 (or yahtml-faithful-to-htmllint (insert " "))

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

1770 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))

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

1772 (yahtml-indent-line)

1773 (and (string-match yahtml-p-prefered-env-regexp "dl")

1774 (string-equal yahtml-last-single-cmd "dt")

1775 (yahtml-insert-p nil))))

1776

1777 (defun yahtml-intelligent-newline-select ()

1778 (interactive)

1779 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")

1780 (yahtml-indent-line))

1781

1782 ;;; ---------- Marking ----------

1783 (defun yahtml-mark-begend ()

1784 "Mark current tag"

1785 (interactive)

1786 (YaTeX-beginning-of-environment)

1787 (let ((p (point)))

1788 (save-excursion

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

1790 (if (bolp) (setq p (point))))

1791 (push-mark p t))

1792 (yahtml-goto-corresponding-begend)

1793 (forward-list 1)

1794 (if (eolp) (forward-char 1)))

1795

1796 ;;; ---------- complete marks ----------

1797 (defun yahtml-complete-mark ()

1798 "Complete &gt, &lt, &ampersand, and &quote."

1799 (interactive)

1800 (message "1:< 2:> 3:& 4:\"")

1801 (let ((c (read-char)))

1802 (setq c (if (or (< c ?0) (> c ?5))

1803 (string-match (regexp-quote (char-to-string c)) "<>&\"")

1804 (- c ?1)))

1805 (if (or (< c 0) (> c 4))

1806 nil

1807 (insert (format "&%s;" (nth c '("lt" "gt" "amp" "quot")))))))

1808

1809

1810 ;;; ---------- jump to error line ----------

1811 (defvar yahtml-error-line-regexp

1812 "^\$.*\$(\$[0-9]+\$):"

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

1814 (defun yahtml-prev-error ()

1815 "Jump to previous error seeing lint buffer."

1816 (interactive)

1817 (or (get-buffer yahtml-lint-buffer)

1818 (error "No lint program ran."))

1819 (YaTeX-showup-buffer yahtml-lint-buffer nil t)

1820 (yahtml-jump-to-error-line t))

1821

1822 (defun yahtml-jump-to-error-line (&optional sit)

1823 (interactive "P")

1824 (let ((p (point)) (e (point-end-of-line)))

1825 (end-of-line)

1826 (if (re-search-backward yahtml-error-line-regexp nil t)

1827 (let ((f (YaTeX-match-string 1))

1828 (l (string-to-int (YaTeX-match-string 2))))

1829 (if sit (sit-for 1))

1830 (forward-line -1)

1831 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)

1832 (goto-line l))

1833 (message "No line number usage"))))

1834

1835 ;;; ---------- ----------

1836

1837 ;;;

1838 ;;hilit19

1839 ;;;

1840 (defvar yahtml-default-face-table

1841 '(

1842 (form black/ivory white/hex-442233 italic)

1843 ))

1844 (defvar yahtml-hilit-patterns-alist

1845 '(

1846 ;; comments

1847 ("" comment)

1848 ;; include&exec

1849 ("" include)

1850 ;; string

1851 (hilit-string-find ?\\ string)

1852 (yahtml-hilit-region-tag "\$em\\|strong\$" bold)

1853 ("</?[uod]l>" 0 decl)

1854 ("<\$di\\|dt\\|li\\|dd\$>" 0 label)

1855 ("<a\\s +href" "</a>" crossref)

1856 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)

1857 ))

1858

1859 (defun yahtml-hilit-region-tag (tag)

1860 "Return list of start/end point of <TAG> form."

1861 (if (re-search-forward (concat "<" tag ">") nil t)

1862 (let ((m0 (match-beginning 0)))

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

1864 (cons (point)

1865 (progn (re-search-forward (concat "</" tag ">") nil t)

1866 (match-beginning 0))))))

1867

1868 (defun yahtml-hilit-region-tag-itself (ptn)

1869 "Return list of start/end point of <tag options...> itself."

1870 (if (re-search-forward ptn nil t)

1871 (let ((m0 (match-beginning 0)))

1872 (skip-chars-forward "^>")

1873 (cons m0 (1+ (point) )))))

1874

1875 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))

1876 (and (featurep 'hilit19)

1877 (or (assq 'yahtml-mode hilit-patterns-alist)

1878 (setq hilit-patterns-alist

1879 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)

1880 hilit-patterns-alist))))

1881

1882 (run-hooks 'yahtml-load-hook)

1883 (provide 'yahtml)

1884

1885 ; Local variables:

1886 ; fill-prefix: ";;; "

1887 ; paragraph-start: "^$\\|\\|;;;$"

1888 ; paragraph-separate: "^$\\|\\|;;;$"

1889 ; End: