yatex
view yahtml.el @ 64:36a48185b95a
Changes are listed in yatex.new.
Major one is supporing GNU Emacs20 and XEmacs.
| author | yuuji |
|---|---|
| date | Tue, 16 Dec 1997 13:28:38 +0000 |
| parents | b9f753846b6b |
| children | 0eb6997bee16 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; (c ) 1994-1997 by HIROSE Yuuji [yuuji@ae.keio.ac.jp]
3 ;;; Last modified Tue Dec 16 21:10:05 1997 on crx
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 ;;;
79 ;;;[キーの説明]
80 ;;;
81 ;;; 以下の説明において、特にカスタマイズをしていない限り、[prefix] は
82 ;;; C-c キーを意味します。
83 ;;;
84 ;;; * [prefix] b X `</H1>' といった終了タグが必要となる`H1'のよう
85 ;;; な環境を補完入力します。<a href=foo> ... </a>
86 ;;; もこのグループです。
87 ;;; `href=...' と入力した後、TABキーを押すことで、
88 ;;; ファイル名や (href="#foo") のようなラベルも補完
89 ;;; できます。
90 ;;; * [prefix] s 以下のような宣言の補完を行います。
91 ;;; `<img src="foo.gif">'
92 ;;; `<input name="var" ...>'
93 ;;; * [prefix] l `<i> ... </i>' や `<samp> ... </samp>' のよう
94 ;;; なテキストスタイル指定のタグを補完します。
95 ;;; この補完機能は通常 [prefix] b で補完できるものを
96 ;;; 一行内で書きたいときにも用いることが出来ます。
97 ;;; * [prefix] m `<br>' や `<hr> '、`<li>' 等の単体タグの補完
98 ;;; を行います。
99 ;;; * [prefix] p カーソル位置に<p></p>を挿入します。
100 ;;; * M-RET おまかせ改行; もしul、ol、dl等のタグ(リスト)を
101 ;;; 使っている場合に、環境に合わせて改行と <li>、
102 ;;; <dt>、<dd>を入力します。
103 ;;; * menu-bar yahtml 選択したアイテムをメニューより補完できます。
104 ;;; (私はメニューが嫌いなんですが、htmlに関してはメ
105 ;;; ニューは一番ありがたいかも)
106 ;;; * [prefix] g 対応するタグ、<dl> <-> </dl> や href="xxx" の
107 ;;; ような TAG にジャンプします。
108 ;;; <img src=...> の場合はイメージビューワを呼び出
109 ;;; します。href=hoge.html の場合はhoge.htmlに飛びま
110 ;;; す。
111 ;;; * [prefix] k ポイント上の HTML タグを消去します。
112 ;;; もし universal-argument を付けた場合(C-uを先に押
113 ;;; す)HTMLタグで囲まれた内容も同時に消去します。
114 ;;; * [prefix] c ポイント上のタグを変更します。
115 ;;; `href="xxx"'の上で [prefix] c を利用した場合は、
116 ;;; 参照しているリンクを補完機能を使いながら変更で
117 ;;; きます。
118 ;;; * [prefix] t j カレントファイルに対して jweblint を呼び出しま
119 ;;; す。
120 ;;; * [prefix] t p WWW ブラウザでカレントファイルを表示します。
121 ;;; (lisp変数 yahtml-www-browser の設定をお忘れな
122 ;;; く。お推めは "netscape" で、ねすけの場合既にねす
123 ;;; けが起動されていた場合そのねすけに Reload 命令を
124 ;;; 送るという芸当が出来ます。ただし今のところX版の
125 ;;; ねすけちゃんだけ)
126 ;;; * [prefix] a YaTeX のアクセント記号補完と同じです。
127 ;;; < > 等が入力できます。
128 ;;;
129 ;;; [謝辞]
130 ;;;
131 ;;; fj野鳥の会の皆さんには貴重な助言を頂きました。また、下に示す方々には
132 ;;; 特に大きな協力を頂きました。あわせてここに感謝申し上げます。
133 ;;;
134 ;;; * 横田和也さん(マツダ)
135 ;;; マニュアルの和訳をして頂きました。
136 ;;; * 吉田尚志さん(NTT Data)
137 ;;; Mule for Win32 での動作のさせ方を教えて頂きました。
138 ;;; (というかほとんどやってもらった ^^;)
139 ;;;
142 ;(require 'yatex)
143 (require 'yatexlib)
144 ;;; --- customizable variable starts here ---
145 (defvar yahtml-prefix "\C-c"
146 "*Prefix key stroke of yahtml functions.")
147 (defvar yahtml-image-viewer "xv" "*Image viewer program")
148 (defvar yahtml-www-browser "netscape"
149 "*WWW Browser command")
150 (defvar yahtml-kanji-code 2
151 "*Kanji coding system number of html file; 1=sjis, 2=jis, 3=euc")
152 (defvar yahtml-coding-system
153 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))
154 "Kanji coding system")
155 (defvar yahtml-fill-column 72 "*fill culumn used for yahtml-mode")
156 (defvar yahtml-fill-prefix nil "*fill prefix for yahtml-mode")
158 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")
159 (defvar yahtml-path-url-alist nil
160 "*Alist of unix path name vs. URL name of WWW server.
161 Ex.
162 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")
163 (\"/usr/home/yuuji/darts/http\" . \"http://darts.comp.ae.keio.ac.jp/~darts\"))")
164 (defvar yahtml-directory-index "index.html"
165 "*Directory index file name;
166 Consult your site's WWW administrator.")
168 (defvar yahtml-environment-indent 1
169 "*Indentation depth of HTML's listing environment")
171 (defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)
172 "Whether yatex mode is running on Japanese environment or not.")
174 (defvar yahtml-lint-program (if YaTeX-japan "jweblint" "weblint")
175 "*Program name to lint HTML file")
176 (defvar yahtml-hate-too-deep-indentation nil
177 "*Non-nil for this variable suppress deep indentation in listing environments.")
179 (defvar yahtml-always-/p nil
180 "*Those who always use <p> with </p> set this to t.")
182 (defvar yahtml-p-prefered-env-regexp "^\\(body\\|dl\\)"
183 "*Regexp of envs where paragraphed sentences are prefered.")
185 (defvar yahtml-template-file "~/http/template.html"
186 "*Template HTML file. It'll be inserted to empty file.")
188 ;;; --- customizable variable ends here ---
189 (defvar yahtml-prefix-map nil)
190 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")
191 (defvar yahtml-lint-buffer-map nil "Keymap used in lint buffer.")
192 (defvar yahtml-shell-command-option
193 (or (and (boundp 'shell-command-option) shell-command-option)
194 (if (eq system-type 'ms-dos) "/c" "-c")))
197 (defun yahtml-define-begend-key-normal (key env &optional map)
198 "Define short cut yahtml-insert-begend key."
199 (YaTeX-define-key
200 key
201 (list 'lambda '(arg) '(interactive "P")
202 (list 'yahtml-insert-begend 'arg env))
203 map))
205 (defun yahtml-define-begend-region-key (key env &optional map)
206 "Define short cut yahtml-insert-begend-region key."
207 (YaTeX-define-key key (list 'lambda nil '(interactive)
208 (list 'yahtml-insert-begend t env)) map))
210 (defun yahtml-define-begend-key (key env &optional map)
211 "Define short cut key for begin type completion both for
212 normal and region mode. To customize yahtml, user should use this function."
213 (yahtml-define-begend-key-normal key env map)
214 (if YaTeX-inhibit-prefix-letter nil
215 (yahtml-define-begend-region-key
216 (concat (upcase (substring key 0 1)) (substring key 1)) env map)))
219 (if yahtml-mode-map nil
220 (setq yahtml-mode-map (make-sparse-keymap)
221 yahtml-prefix-map (make-sparse-keymap))
222 (define-key yahtml-mode-map yahtml-prefix yahtml-prefix-map)
223 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)
224 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)
225 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))
226 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)
227 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)
228 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)
229 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)
230 (let ((map yahtml-prefix-map))
231 (YaTeX-define-key "^" 'yahtml-visit-main map)
232 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)
233 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)
234 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)
235 (and YaTeX-emacs-19 window-system
236 (progn
237 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
238 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
239 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
240 (YaTeX-define-key "v" 'YaTeX-version map)
241 (YaTeX-define-key "}" 'YaTeX-insert-braces-region map)
242 (YaTeX-define-key "]" 'YaTeX-insert-brackets-region map)
243 (YaTeX-define-key ")" 'YaTeX-insert-parens-region map)
244 (YaTeX-define-key "s" 'yahtml-insert-form map)
245 (YaTeX-define-key "l" 'yahtml-insert-tag map)
246 (YaTeX-define-key "L" 'yahtml-insert-tag-region map)
247 (YaTeX-define-key "m" 'yahtml-insert-single map)
248 (YaTeX-define-key "n" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<BR>" "<br>"))) map)
249 (YaTeX-define-key "-" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<HR>" "<hr>") "\n")) map)
250 (YaTeX-define-key "p" 'yahtml-insert-p map)
251 (if YaTeX-no-begend-shortcut
252 (progn
253 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)
254 (YaTeX-define-key "b" 'yahtml-insert-begend map))
255 (yahtml-define-begend-key "bh" "html" map)
256 (yahtml-define-begend-key "bH" "head" map)
257 (yahtml-define-begend-key "bt" "title" map)
258 (yahtml-define-begend-key "bT" "table" map)
259 (yahtml-define-begend-key "bb" "body" map)
260 (yahtml-define-begend-key "bc" "center" map)
261 (yahtml-define-begend-key "bd" "dl" map)
262 (yahtml-define-begend-key "bu" "ul" map)
263 (yahtml-define-begend-key "b1" "h1" map)
264 (yahtml-define-begend-key "b2" "h2" map)
265 (yahtml-define-begend-key "b3" "h3" map)
266 (yahtml-define-begend-key "ba" "a" map)
267 (yahtml-define-begend-key "bf" "form" map)
268 (yahtml-define-begend-key "bs" "select" map)
269 (YaTeX-define-key "b " 'yahtml-insert-begend map)
270 (YaTeX-define-key "B " 'yahtml-insert-begend-region map)
271 )
272 (YaTeX-define-key "e" 'YaTeX-end-environment map)
273 (YaTeX-define-key ">" 'yahtml-comment-region map)
274 (YaTeX-define-key "<" 'yahtml-uncomment-region map)
275 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)
276 (YaTeX-define-key "k" 'yahtml-kill-* map)
277 (YaTeX-define-key "c" 'yahtml-change-* map)
278 (YaTeX-define-key "t" 'yahtml-browse-menu map)
279 (YaTeX-define-key "a" 'yahtml-complete-mark map)
280 (YaTeX-define-key "'" 'yahtml-prev-error map)
281 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
282 ))
284 (if yahtml-lint-buffer-map nil
285 (setq yahtml-lint-buffer-map (make-keymap))
286 (define-key yahtml-lint-buffer-map " " 'yahtml-jump-to-error-line))
289 (defvar yahtml-paragraph-start
290 (concat
291 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|[bhtd][rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\)\\b")
292 "*Regexp of html paragraph separater")
293 (defvar yahtml-paragraph-separate
294 (concat
295 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|[bhtd][ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\|!--\\)\\b")
296 "*Regexp of html paragraph separater")
297 (defvar yahtml-syntax-table nil
298 "*Syntax table for yahtml-mode")
300 (if yahtml-syntax-table nil
301 (setq yahtml-syntax-table
302 (make-syntax-table (standard-syntax-table)))
303 (modify-syntax-entry ?\< "(>" yahtml-syntax-table)
304 (modify-syntax-entry ?\> ")<" yahtml-syntax-table)
305 (modify-syntax-entry ?\n " " yahtml-syntax-table)
306 )
307 (defvar yahtml-command-regexp "[A-Za-z0-9]+"
308 "Regexp of constituent of html commands.")
310 ;;; Completion tables for `form'
311 (defvar yahtml-form-table
312 '(("img") ("input")))
313 (defvar yahtml-user-form-table nil)
314 (defvar yahtml-tmp-form-table nil)
315 (defvar yahtml-last-form "img")
317 (defvar yahtml-env-table
318 '(("html") ("head") ("title") ("body") ("dl") ("ul") ("ol") ("pre")
319 ("a") ("form") ("select") ("center") ("textarea") ("blockquote")
320 ("OrderedList" . "ol")
321 ("UnorderedList" . "ul")
322 ("DefinitionList" . "dl")
323 ("Preformatted" . "pre")
324 ("table") ("tr") ("th") ("td")
325 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6")
326 ;; ("p") ;This makes indentation screwed up!
327 ))
329 (defvar yahtml-itemizing-regexp
330 "\\(ul\\|ul\\|dl\\)"
331 "Regexp of itemizing forms")
333 (defvar yahtml-user-env-table nil)
334 (defvar yahtml-tmp-env-table nil)
336 ;;; Completion tables for typeface designator
337 (and yahtml-always-/p
338 (or (assoc "p" yahtml-env-table)
339 (setq yahtml-env-table (cons '("p") yahtml-env-table))))
341 (defvar yahtml-typeface-table
342 (append
343 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp")
344 ("strong") ("var") ("b") ("i") ("tt") ("u") ("address") ("font"))
345 yahtml-env-table)
346 "Default completion table of typeface designator")
347 (defvar yahtml-user-typeface-table nil)
348 (defvar yahtml-tmp-typeface-table nil)
349 (defvar yahtml-last-typeface-cmd "a")
351 (defvar yahtml-single-cmd-table
352 '(("hr") ("br") ("option") ("p")
353 ("HorizontalLine" . "hr")
354 ("BreakLine" . "br")
355 ("Paragraph" . "p")
356 ("Item" . "li")
357 ("DefineTerm" . "dt")
358 ("Description" . "dd")
359 ("dd") ("dt") ("li")
360 )
361 "Default completion table of HTML single command.")
362 (defvar yahtml-user-single-cmd-table nil)
363 (defvar yahtml-tmp-single-cmd-table nil)
364 (defvar yahtml-last-single-cmd nil)
366 (defvar yahtml-prefer-upcases nil)
368 ;(defvar yahtml-struct-name-regexp
369 ; "\\<\\(h[1-6]\\|[uod]l\\|html\\|body\\|title\\|head\\|table\\|t[rhd]\\|pre\\|a\\|form\\|select\\|center\\|blockquote\\)\\b")
370 (defvar yahtml-struct-name-regexp
371 (concat
372 "\\<\\("
373 (mapconcat (function (lambda (x) (car x))) yahtml-typeface-table "\\|")
374 "\\)\\b")
375 "Regexp of structure beginning.")
376 (or (assoc "p" yahtml-env-table)
377 (setq yahtml-env-table (cons '("p") yahtml-env-table)))
379 (defun yahtml-mode ()
380 (interactive)
381 (cond
382 ((and YaTeX-emacs-20 (fboundp 'coding-system-equal))
383 (if t (or (coding-system-equal
384 yahtml-coding-system buffer-file-coding-system)
385 (set-buffer-file-coding-system yahtml-coding-system))
386 ;;^v which is better?
387 (let ((bmp (buffer-modified-p)))
388 (set-buffer-file-coding-system yahtml-coding-system)
389 (set-buffer-modified-p bmp))))
390 ((featurep 'mule)
391 (set-file-coding-system yahtml-coding-system))
392 ((boundp 'NEMACS)
393 (make-local-variable 'kanji-fileio-code)
394 (setq kanji-fileio-code yahtml-kanji-code)))
395 (setq major-mode 'yahtml-mode
396 mode-name "yahtml")
397 (mapcar
398 (function (lambda (x)
399 (make-local-variable (car x))
400 (set (car x) (if (and (symbolp (cdr x))
401 (boundp (cdr x)))
402 (symbol-value (cdr x))
403 (cdr x)))))
404 '((YaTeX-ec . "")
405 (YaTeX-struct-begin . "<%1%2")
406 (YaTeX-struct-end . "</%1>")
407 (YaTeX-struct-name-regexp . yahtml-struct-name-regexp)
408 (YaTeX-comment-prefix . "<!--")
409 (YaTeX-coding-system . yahtml-coding-system)
410 (YaTeX-typesetting-mode-map . yahtml-lint-buffer-map)
411 (fill-prefix . yahtml-fill-prefix) (fill-column . yahtml-fill-column)
412 (paragraph-start . yahtml-paragraph-start)
413 (paragraph-separate . yahtml-paragraph-separate)
414 (comment-start . "<!-- ") (comment-end . " -->")
415 (comment-start-skip . comment-start)
416 (indent-line-function . yahtml-indent-line)))
418 (set-syntax-table yahtml-syntax-table)
419 (use-local-map yahtml-mode-map)
420 (YaTeX-read-user-completion-table)
421 (turn-on-auto-fill) ;Sorry, this is prerequisite
422 (and (= 0 (buffer-size)) (file-exists-p yahtml-template-file)
423 (y-or-n-p (format "Insert %s?" yahtml-template-file))
424 (insert-file-contents (expand-file-name yahtml-template-file)))
425 (run-hooks 'text-mode-hook 'yahtml-mode-hook))
427 (defun yahtml-define-menu (keymap bindlist)
428 (cond
429 ((featurep 'xemacs)
430 (let ((name (keymap-name (symbol-value keymap))))
431 (set keymap nil)
432 (mapcar
433 (function
434 (lambda (bind)
435 (setq bind (cdr bind))
436 (if (eq (car (cdr bind)) 'lambda)
437 (setcar (cdr bind) 'progn))
438 (if (stringp (car (cdr bind)))
439 (set keymap (cons (cdr bind) (symbol-value keymap)))
440 (set keymap (cons (vector (car bind) (cdr bind) t)
441 (symbol-value keymap))))))
442 bindlist)
443 (set keymap (cons name (symbol-value keymap)))))
444 (t
445 (mapcar
446 (function
447 (lambda (bind)
448 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
449 bindlist))))
451 (defvar yahtml-menu-map nil "Menu map of yahtml")
452 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")
453 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")
454 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")
455 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")
457 ;;; Variables for mosaic url history
458 (defvar yahtml-urls nil "Alist of global history")
459 (defvar yahtml-urls-private nil)
460 (defvar yahtml-urls-local nil)
462 (cond
463 ((and YaTeX-emacs-19 (null yahtml-menu-map))
464 (setq yahtml-menu-map (make-sparse-keymap "yahtml"))
465 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))
466 (YaTeX-define-menu
467 'yahtml-menu-map-sectioning
468 (nreverse
469 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))
470 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))
471 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))
472 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))
473 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))
474 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))
475 )))
476 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))
477 (YaTeX-define-menu
478 'yahtml-menu-map-logical
479 (nreverse
480 '((em "Embolden" .
481 (lambda () (interactive) (yahtml-insert-tag nil "EM")))
482 (dfn "Define a word" .
483 (lambda () (interactive) (yahtml-insert-tag nil "DFN")))
484 (cite "Citation" .
485 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))
486 (code "Code" .
487 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))
488 (kbd "Keyboard" .
489 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))
490 (samp "Sample display" .
491 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))
492 (strong "Strong" .
493 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))
494 (VAR "Variable notation" .
495 (lambda () (interactive) (yahtml-insert-tag nil "VAR")))
496 )))
497 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))
498 (YaTeX-define-menu
499 'yahtml-menu-map-typeface
500 (nreverse
501 '((b "Bold" .
502 (lambda () (interactive) (yahtml-insert-tag nil "B")))
503 (i "Italic" .
504 (lambda () (interactive) (yahtml-insert-tag nil "I")))
505 (tt "Typewriter" .
506 (lambda () (interactive) (yahtml-insert-tag nil "TT")))
507 (u "Underlined" .
508 (lambda () (interactive) (yahtml-insert-tag nil "U")))
509 )))
510 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))
511 (YaTeX-define-menu
512 'yahtml-menu-map-listing
513 (nreverse
514 '((ul "Unordered" .
515 (lambda () (interactive) (yahtml-insert-begend nil "UL")))
516 (ol "Ordered" .
517 (lambda () (interactive) (yahtml-insert-begend nil "OL")))
518 (dl "Definition" .
519 (lambda () (interactive) (yahtml-insert-begend nil "DL")))
520 )))
521 (setq yahtml-menu-map-item (make-sparse-keymap "item"))
522 (YaTeX-define-menu
523 'yahtml-menu-map-item
524 (nreverse
525 '((li "Simple item" .
526 (lambda () (interactive) (yahtml-insert-single "li")))
527 (dt "Define term" .
528 (lambda () (interactive) (yahtml-insert-single "dt")))
529 (dd "Description of term" .
530 (lambda () (interactive) (yahtml-insert-single "dd")))
531 )))
532 (define-key yahtml-mode-map [menu-bar yahtml]
533 (cons "yahtml" yahtml-menu-map))
534 (let ((keys (where-is-internal 'fill-paragraph global-map)))
535 (while keys
536 (define-key yahtml-mode-map (car keys) 'yahtml-fill-paragraph)
537 (setq keys (cdr keys))))
538 (YaTeX-define-menu
539 'yahtml-menu-map
540 (nreverse
541 (list
542 (cons (list 'sect "Sectioning")
543 (cons "sectioning" yahtml-menu-map-sectioning))
544 (cons (list 'list "Listing")
545 (cons "Listing" yahtml-menu-map-listing))
546 (cons (list 'item "Item")
547 (cons "Itemizing" yahtml-menu-map-item));;;
548 (cons (list 'logi "Logical tags")
549 (cons "logical" yahtml-menu-map-logical))
550 (cons (list 'type "Typeface tags")
551 (cons "typeface" yahtml-menu-map-typeface))
552 )))
553 (if (featurep 'xemacs)
554 (add-hook 'yahtml-mode-hook
555 '(lambda ()
556 (or (assoc "yahtml" current-menubar)
557 (progn
558 (set-buffer-menubar (copy-sequence current-menubar))
559 (add-submenu nil yahtml-menu-map))))))
560 ))
562 ;;; ----------- Completion ----------
563 (defvar yahtml-last-begend "html")
564 (defun yahtml-insert-begend (&optional region env)
565 "Insert <cmd> ... </cmd>."
566 (interactive "P")
567 (let*((completion-ignore-case t)
568 (cmd
569 (or env
570 (YaTeX-cplread-with-learning
571 (format "Environment(default %s): " yahtml-last-begend)
572 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))
573 (bolp (save-excursion
574 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))
575 (cc (current-column)))
576 (if (string< "" cmd) (setq yahtml-last-begend cmd))
577 (setq yahtml-last-begend
578 (or (cdr (assoc yahtml-last-begend yahtml-env-table))
579 yahtml-last-begend))
580 (setq cmd yahtml-last-begend)
581 (if yahtml-prefer-upcases (setq cmd (upcase cmd)))
582 (if region
583 (let ((beg (region-beginning))
584 (end (region-end))
585 (addin (yahtml-addin cmd)))
586 (goto-char end)
587 (insert (format "</%s>%s" cmd (if bolp "\n" "")))
588 (goto-char beg)
589 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" ""))))
590 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))
591 (save-excursion
592 (insert "\n")
593 (indent-to-column cc)
594 (insert (format "</%s>" cmd)))
595 (if (string-match "^a\\|p$" cmd) ;aとp決め打ちってのが美しくない…
596 (newline)
597 (yahtml-intelligent-newline nil))
598 (yahtml-indent-line))))
600 (defun yahtml-insert-begend-region ()
601 "Call yahtml-insert-begend in the region mode."
602 (interactive)
603 (yahtml-insert-begend t))
606 (defun yahtml-insert-form (&optional form)
607 "Insert <FORM option=\"argument\">."
608 (interactive)
609 (or form
610 (let ((completion-ignore-case t))
611 (setq form
612 (YaTeX-cplread-with-learning
613 (format "Form(default %s): " yahtml-last-form)
614 'yahtml-form-table 'yahtml-user-form-table
615 'yahtml-tmp-form-table))))
616 (let ((p (point)) q)
617 (if (string= form "") (setq form yahtml-last-form))
618 (setq yahtml-last-form form)
619 (if yahtml-prefer-upcases (setq form (upcase form)))
620 (insert (format "<%s%s>" form (yahtml-addin form)))
621 ;;(indent-relative-maybe)
622 (if (cdr (assoc form yahtml-form-table))
623 (save-excursion (insert (format "</%s>" form))))
624 (if (search-backward "\"\"" p t) (forward-char 1))))
626 ;;; ---------- Add-in ----------
627 (defun yahtml-addin (form)
628 "Check add-in function's existence and call it if exists."
629 (let ((addin (concat "yahtml:" (downcase form))) s)
630 (if (and (intern-soft addin) (fboundp (intern-soft addin))
631 (stringp (setq s (funcall (intern addin))))
632 (string< "" s))
633 (if (eq (aref s 0) ? ) s (concat " " s))
634 "")))
637 (defvar yahtml-completing-buffer nil)
638 (defun yahtml-collect-labels (&optional file)
639 "Collect current buffers label (<a name=...>).
640 If optional argument FILE is specified collect labels in FILE."
641 (let (list bound)
642 (save-excursion
643 (set-buffer yahtml-completing-buffer)
644 (if file (let (hilit-auto-highlight)
645 (set-buffer (find-file-noselect file))))
646 (save-excursion
647 (goto-char (point-min))
648 (while (re-search-forward "<a\\b" nil t)
649 (setq bound (match-end 0))
650 (search-forward ">" nil t)
651 (if (and (re-search-backward "\\(name\\|id\\)=" bound t)
652 (progn
653 (goto-char (match-end 0))
654 (skip-chars-forward " \t\n")
655 (looking-at "\"?#?\\([^\">]+\\)\"?\\b")))
656 (setq list (cons
657 (list (concat "#" (YaTeX-match-string 1)))
658 list))))
659 list)))
660 )
662 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")
663 (if yahtml-url-completion-map nil
664 (setq yahtml-url-completion-map
665 (copy-keymap minibuffer-local-completion-map))
666 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)
667 (define-key yahtml-url-completion-map " " 'yahtml-complete-url)
668 )
670 (defun yahtml-complete-url ()
671 "Complete external URL from history or local file name."
672 (interactive)
673 (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels)
674 (setq initial (buffer-string))
675 (cond
676 ((string-match "^http:" initial)
677 (setq cmpl (try-completion initial yahtml-urls)
678 listfunc (list 'lambda nil
679 (list 'all-completions initial 'yahtml-urls))
680 beg (point-min)))
681 ((setq beg (string-match "#" initial))
682 (or (equal beg 0) ;begin with #
683 (progn
684 (setq path (substring initial 0 beg))
685 (if (string-match "^/" path)
686 (setq path (yahtml-url-to-path path)))))
687 (setq initial (substring initial beg))
688 (setq labels (yahtml-collect-labels path)
689 cmpl (try-completion initial labels)
690 listfunc (list 'lambda ()
691 (list 'all-completions
692 initial (list 'quote labels)))
693 beg (+ (point-min) beg)))
694 (t
695 (setq path (if (string-match "^/" initial)
696 (or (yahtml-url-to-path initial) initial)
697 initial))
698 (setq dir (or (file-name-directory path) ".")
699 file (file-name-nondirectory path)
700 initial file
701 cmpl (file-name-completion file dir)
702 listfunc (list 'lambda nil
703 (list 'file-name-all-completions
704 file dir))
705 beg (save-excursion (skip-chars-backward "^/") (point)))))
706 (cond
707 ((stringp cmpl)
708 (if (string= initial cmpl)
709 (with-output-to-temp-buffer "*Completions*"
710 (princ "Possible completinos are:\n")
711 (princ
712 (mapconcat '(lambda (x) x) (funcall listfunc) "\n")))
713 (delete-region (point) beg)
714 (insert cmpl)))
715 ((null cmpl)
716 (ding))
717 ((eq t cmpl)
718 (save-excursion
719 (unwind-protect
720 (progn
721 (goto-char p)
722 (insert " [Sole completion]"))
723 (delete-region p (point-max))))))))
725 (defun yahtml:a ()
726 "Add-in function for <a>"
727 (let ((href ""))
728 (setq yahtml-completing-buffer (current-buffer)
729 href (read-from-minibuffer "href: " "" yahtml-url-completion-map)
730 ;; yahtml-urls-local is buffer-local, so we must put
731 ;; that into yahtml-urls here
732 yahtml-urls (append yahtml-urls-private yahtml-urls-local))
733 (prog1
734 (concat (yahtml-make-optional-argument
735 "href" href)
736 (yahtml-make-optional-argument
737 "name" (read-string "name: ")))
738 (if (and (string-match "^http://" href)
739 (null (assoc href yahtml-urls)))
740 (YaTeX-update-table
741 (list href)
742 'yahtml-urls-private 'yahtml-urls-private 'yahtml-urls-local))
743 )))
745 (defvar yahtml-parameters-completion-alist
746 '(("align" ("top") ("middle") ("bottom") ("left") ("right") ("center"))
747 ("src" . file)
748 ("method" ("POST") ("GET"))))
750 (defun yahtml-read-parameter (par)
751 (let* ((alist (cdr-safe (assoc (downcase par)
752 yahtml-parameters-completion-alist)))
753 (prompt (concat par ": "))
754 v)
755 (cond
756 ((eq alist 'file)
757 (read-file-name prompt "" nil nil ""))
758 (alist
759 (completing-read prompt alist))
760 (t
761 (read-string prompt)))))
763 (defun yahtml-make-optional-argument (opt arg)
764 "Make optional argument string."
765 (if (string= "" arg)
766 ""
767 (concat " " (if yahtml-prefer-upcases (upcase opt) (downcase opt))
768 "=\"" arg "\"")))
770 (defun yahtml:body ()
771 "Add-in function for <body>"
772 (let ((b (read-string "bgcolor="))
773 (x (read-string "text color="))
774 (l (read-string "link color="))
775 (v (read-string "vlink color=")))
776 (concat
777 (yahtml-make-optional-argument "bgcolor" b)
778 (yahtml-make-optional-argument "text" x)
779 (yahtml-make-optional-argument "link" l)
780 (yahtml-make-optional-argument "vlink" v))))
783 (defun yahtml:img ()
784 "Add-in function for <img>"
785 (let ((src (yahtml-read-parameter "src"))
786 (alg (yahtml-read-parameter "align"))
787 (alt (yahtml-read-parameter "alt"))
788 (brd (read-string "border="))
789 (l yahtml-prefer-upcases))
790 (concat (if l "SRC" "src") "=\"" src "\""
791 (yahtml-make-optional-argument "align" alg)
792 (yahtml-make-optional-argument "alt" alt)
793 (yahtml-make-optional-argument "border" brd))))
795 (defun yahtml:form ()
796 "Add-in function `form' input format"
797 (concat
798 " " (if yahtml-prefer-upcases "METHOD" "method=")
799 (completing-read "Method: " '(("POST") ("GET")) nil t)
800 " " (if yahtml-prefer-upcases "ACTION" "action") "=\""
801 (read-string "Action: ") "\""
802 ))
804 (defun yahtml:select ()
805 "Add-in function for `select' input format"
806 (setq yahtml-last-single-cmd "option")
807 (concat " " (if yahtml-prefer-upcases "NAME" "name") "=\""
808 (read-string "name: ") "\""))
810 (defun yahtml:ol ()
811 (setq yahtml-last-single-cmd "li") "")
812 (defun yahtml:ul ()
813 (setq yahtml-last-single-cmd "li") "")
814 (defun yahtml:dl ()
815 (setq yahtml-last-single-cmd "dt") "")
816 (defun yahtml:dt ()
817 (setq yahtml-last-single-cmd "dd") "")
819 (defun yahtml:p ()
820 (let ((alg (yahtml-read-parameter "align")))
821 (yahtml-make-optional-argument "align" alg)
822 ))
824 (defvar yahtml-input-types
825 '(("text") ("password") ("checkbox") ("radio") ("submit")
826 ("reset") ("image") ("hidden") ("file")))
828 (defun yahtml:input ()
829 "Add-in function for `input' form"
830 (let ((size "") name type value checked (maxlength "")
831 (l yahtml-prefer-upcases))
832 (setq name (read-string "name: ")
833 type (completing-read "type (default=text): "
834 yahtml-input-types nil t)
835 value (read-string "value: "))
836 (if (string-match "text\\|password\\|^$" type)
837 (setq size (read-string "size: ")
838 maxlength (read-string "maxlength: ")))
839 (concat
840 (if l "NAME" "name") "=\"" name "\""
841 (yahtml-make-optional-argument "type" type)
842 (yahtml-make-optional-argument "value" value)
843 (yahtml-make-optional-argument "size" size)
844 (yahtml-make-optional-argument "maxlength" maxlength)
845 )))
847 (defun yahtml:textarea ()
848 "Add-in function for `textarea'"
849 (interactive)
850 (let (name rows cols)
851 (setq name (read-string "Name: ")
852 cols (read-string "Columns: ")
853 rows (read-string "Rows: "))
854 (concat
855 (concat (if yahtml-prefer-upcases "NAME=" "name=")
856 "\"" name "\"")
857 (yahtml-make-optional-argument "cols" cols)
858 (yahtml-make-optional-argument "rows" rows))))
860 (defun yahtml:table ()
861 "Add-in function for `table'"
862 (yahtml-make-optional-argument "border" (read-string "border=")))
864 (defun yahtml:font ()
865 "Add-in function for `font'"
866 (yahtml-make-optional-argument "color" (read-string "color=")))
868 ;;; ---------- Simple tag ----------
869 (defun yahtml-insert-tag (region-mode &optional tag)
870 "Insert <TAG> </TAG> and put cursor inside of them."
871 (interactive "P")
872 (or tag
873 (let ((completion-ignore-case t))
874 (setq tag
875 (YaTeX-cplread-with-learning
876 (format "Tag %s(default %s): "
877 (if region-mode "region: " "") yahtml-last-typeface-cmd)
878 'yahtml-typeface-table 'yahtml-user-typeface-table
879 'yahtml-tmp-typeface-table))))
880 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))
881 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))
882 (setq yahtml-last-typeface-cmd tag
883 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))
884 (if region-mode
885 (if (if (string< "19" emacs-version) (mark t) (mark))
886 (save-excursion
887 (if (> (point) (mark)) (exchange-point-and-mark))
888 (insert (format "<%s%s>" tag (yahtml-addin tag)))
889 (exchange-point-and-mark)
890 (insert "</" tag ">"))
891 (message "No mark set now"))
892 (insert (format "<%s%s>" tag (yahtml-addin tag)))
893 (save-excursion (insert (format "</%s>" tag)))))
895 (defun yahtml-insert-tag-region (&optional tag)
896 "Call yahtml-insert-tag with region mode."
897 (interactive)
898 (yahtml-insert-tag t tag))
901 (defun yahtml-insert-single (cmd)
902 "Insert <CMD>."
903 (interactive
904 (list
905 (let ((completion-ignore-case t))
906 (YaTeX-cplread-with-learning
907 (format "Command%s: "
908 (if yahtml-last-single-cmd
909 (concat "(default " yahtml-last-single-cmd ")") ""))
910 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table
911 'yahtml-tmp-single-cmd-table))))
912 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))
913 (setq yahtml-last-single-cmd
914 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))
915 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
916 yahtml-last-single-cmd))
917 (insert (format "<%s>" cmd)))
919 (defun yahtml-insert-p (&optional arg)
920 "Convenient function to insert <p></p>"
921 (interactive "P")
922 (if arg (yahtml-insert-tag nil "p")
923 (insert "<p>")
924 (save-excursion
925 (insert "</p>"))))
927 ;;; ---------- Jump ----------
928 (defun yahtml-on-href-p ()
929 "Check if point is on href clause."
930 (let ((p (point)) e cmd (case-fold-search t))
931 (save-excursion
932 (and (string= (YaTeX-inner-environment t) "a")
933 (save-excursion
934 (search-forward "</a>" nil t)
935 (setq e (point)))
936 (goto-char (get 'YaTeX-inner-environment 'point))
937 (search-forward "href" e t)
938 (search-forward "=" e t)
939 (progn
940 (skip-chars-forward " \t\n")
941 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
942 (< p (match-end 0))
943 (YaTeX-match-string 1)
944 ))))
946 (defun yahtml-netscape-sentinel (proc mes)
947 (cond
948 ((null (buffer-name (process-buffer proc)))
949 (set-process-buffer proc nil))
950 ((eq (process-status proc) 'exit)
951 (let ((cb (current-buffer)))
952 (set-buffer (process-buffer proc))
953 (goto-char (point-min))
954 (if (search-forward "not running" nil t)
955 (progn
956 (message "Starting netscape...")
957 (start-process
958 "browser" (process-buffer proc)
959 shell-file-name yahtml-shell-command-option
960 (format "%s \"%s\"" yahtml-www-browser
961 (get 'yahtml-netscape-sentinel 'url)))
962 (message "Starting netscape...Done")))
963 (set-buffer cb)))))
965 (defvar yahtml-browser-process nil)
967 (defun yahtml-browse-html (href)
968 "Call WWW Browser to see HREF."
969 (let ((pb "* WWW Browser *") (cb (current-buffer)))
970 (cond
971 ((string-match "^start\\>" yahtml-www-browser)
972 (if (get-buffer pb)
973 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
974 (put 'yahtml-netscape-sentinel 'url href)
975 (set-process-sentinel
976 (setq yahtml-browser-process
977 (start-process
978 "browser" pb shell-file-name yahtml-shell-command-option
979 (format "%s \"%s\"" yahtml-www-browser href)))
980 'yahtml-netscape-sentinel))
981 ((and (string-match "[Nn]etscape" yahtml-www-browser)
982 (not (eq system-type 'windows-nt)))
983 (if (get-buffer pb)
984 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
985 (put 'yahtml-netscape-sentinel 'url href)
986 (set-process-sentinel
987 (setq yahtml-browser-process
988 (start-process
989 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
990 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))
991 'yahtml-netscape-sentinel))
992 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))
993 (w3-fetch href))
994 ((stringp yahtml-www-browser)
995 (if (and yahtml-browser-process
996 (eq (process-status yahtml-browser-process) 'run))
997 (message "%s is already running" yahtml-www-browser)
998 (setq yahtml-browser-process
999 (start-process
1000 "browser" "* WWW Browser *"
1001 shell-file-name yahtml-shell-command-option
1002 (format "%s \"%s\"" yahtml-www-browser href)))))
1003 (t
1004 (message "Sorry, jump across http is not supported.")))))
1006 (defun yahtml-goto-corresponding-href (&optional other)
1007 "Go to corresponding name."
1008 (let ((href (yahtml-on-href-p)) file name (parent buffer-file-name))
1009 (if href
1010 (cond
1011 ((string-match "^\\(ht\\|f\\)tp:" href)
1012 (yahtml-browse-html href))
1013 (t (setq file (substring href 0 (string-match "#" href)))
1014 (if (string-match "#" href)
1015 (setq name (substring href (1+ (string-match "#" href)))))
1016 (if (string< "" file)
1017 (progn
1018 (if (string-match "/$" file)
1019 (setq file (concat file yahtml-directory-index)))
1020 (if (string-match "^/" file)
1021 (setq file (yahtml-url-to-path file)))
1022 (if other (YaTeX-switch-to-buffer-other-window file)
1023 (YaTeX-switch-to-buffer file))
1024 (or YaTeX-parent-file (setq YaTeX-parent-file parent))))
1025 (if name
1026 (progn (set-mark-command nil) (yahtml-jump-to-name name)))
1027 t)))))
1029 (defun yahtml-jump-to-name (name)
1030 "Jump to html's named tag."
1031 (setq name (format "name\\s *=\\s *\"?%s\"?" name))
1032 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))
1033 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))
1034 (message "Named tag `%s' not found" (substring href 1))))
1036 (defun yahtml-on-begend-p (&optional p)
1037 "Check if point is on begend clause."
1038 (let ((p (or p (point))) cmd (case-fold-search t))
1039 (save-excursion
1040 (goto-char p)
1041 (if (equal (char-after (point)) ?<) (forward-char 1))
1042 (if (and (re-search-backward "<" nil t)
1043 (looking-at
1044 (concat "<\\(/?" yahtml-struct-name-regexp "\\)\\b"))
1045 (condition-case nil
1046 (forward-list 1)
1047 (error nil))
1048 (< p (point)))
1049 (YaTeX-match-string 1)))))
1051 (defun yahtml-goto-corresponding-begend (&optional noerr)
1052 "Go to corresponding opening/closing tag.
1053 Optional argument NOERR causes no error for unballanced tag."
1054 (let ((cmd (yahtml-on-begend-p)) m0
1055 (p (point)) (case-fold-search t) func str (nest 0))
1056 (cond
1057 (cmd
1058 (setq m0 (match-beginning 0))
1059 (if (= (aref cmd 0) ?/) ;on </cmd> line
1060 (setq cmd (substring cmd 1)
1061 str (format "\\(<%s\\)\\|\\(</%s\\)" cmd cmd)
1062 func 're-search-backward)
1063 (setq str (format "\\(</%s\\)\\|\\(<%s\\)" cmd cmd)
1064 func 're-search-forward))
1065 (while (and (>= nest 0) (funcall func str nil t))
1066 (if (equal m0 (match-beginning 0))
1067 nil
1068 (setq nest (+ nest (if (match-beginning 1) -1 1)))))
1069 (if (< nest 0)
1070 (goto-char (match-beginning 0))
1071 (funcall
1072 (if noerr 'message 'error)
1073 "Corresponding tag of `%s' not found." cmd)
1074 (goto-char p)
1075 nil))
1076 (t nil))))
1078 (defun yahtml-current-tag ()
1079 "Return the current tag name."
1080 (save-excursion
1081 (let ((p (point)) b tag)
1082 (or (bobp)
1083 (looking-at "<")
1084 (progn (skip-chars-backward "^<") (forward-char -1)))
1085 (setq b (point))
1086 (skip-chars-forward "<")
1087 (setq tag (buffer-substring
1088 (point) (progn (skip-chars-forward "^ \t\n") (point))))
1089 (goto-char b)
1090 (forward-list 1)
1091 (and (< p (point)) tag))))
1094 (defun yahtml-goto-corresponding-img ()
1095 "View image on point"
1096 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))
1097 (if (and tag
1098 (string-match "img" tag)
1099 (save-excursion
1100 (re-search-backward "<\\s *img" nil t)
1101 (re-search-forward "src=\"?\\([^\"> ]+\\)\"?")
1102 (match-beginning 1)
1103 (setq image
1104 (buffer-substring (match-beginning 1) (match-end 1)))))
1105 (progn
1106 (message "Invoking %s %s..." yahtml-image-viewer image)
1107 (start-process
1108 "Viewer" " * Image Viewer *"
1109 shell-file-name yahtml-shell-command-option ;"-c"
1110 (concat yahtml-image-viewer " " image))
1111 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))
1113 (defun yahtml-goto-corresponding-* (&optional other)
1114 "Go to corresponding object."
1115 (interactive)
1116 (cond
1117 ((yahtml-goto-corresponding-href other))
1118 ((yahtml-goto-corresponding-img))
1119 ((yahtml-goto-corresponding-begend))
1120 (t (message "I don't know where to go."))
1121 ))
1123 (defun yahtml-goto-corresponding-*-other-window ()
1124 "Go to corresponding object."
1125 (interactive)
1126 (yahtml-goto-corresponding-* t))
1128 (defun yahtml-visit-main ()
1129 "Go to parent file from where you visit current file."
1130 (interactive)
1131 (if YaTeX-parent-file (YaTeX-switch-to-buffer YaTeX-parent-file)))
1133 ;;; ---------- killing ----------
1134 (defun yahtml-kill-begend (&optional whole)
1135 (let ((tag (yahtml-on-begend-p)) p q r)
1136 (if tag
1137 (save-excursion
1138 (or (looking-at "<")
1139 (progn (skip-chars-backward "^<") (forward-char -1)))
1140 (setq p (point))
1141 (yahtml-goto-corresponding-begend)
1142 (or (looking-at "<")
1143 (progn (skip-chars-backward "^<") (forward-char -1)))
1144 (if (< (point) p) ;if on the opening tag
1145 (progn (setq q p p (point))
1146 (goto-char q))
1147 (setq q (point))) ;now q has end-line's (point)
1148 (if (not whole)
1149 (kill-region
1150 (progn (skip-chars-backward " \t") (if (bolp) (point) q))
1151 (progn (forward-list 1)
1152 (setq r (point))
1153 (skip-chars-forward " \t")
1154 (if (and (eolp) (not (eobp))) (1+ (point)) r))))
1155 (goto-char p)
1156 (skip-chars-backward " \t")
1157 (if (not whole)
1158 (progn
1159 (kill-append
1160 (buffer-substring
1161 (setq p (if (bolp) (point) p))
1162 (setq q (progn
1163 (forward-list 1)
1164 (setq r (point))
1165 (skip-chars-forward " \t")
1166 (if (and (eolp) (not (eobp))) (1+ (point)) r))))
1167 t)
1168 (delete-region p q))
1169 (kill-region
1170 (if (bolp) (point) p)
1171 (progn (goto-char q)
1172 (forward-list 1)
1173 (setq r (point))
1174 (skip-chars-forward " \t")
1175 (if (and (eolp) (not (eobp))) (1+ (point)) r))))
1176 tag))))
1178 (defun yahtml-kill-* (whole)
1179 "Kill current position's HTML tag (set)."
1180 (interactive "P")
1181 (cond
1182 ((yahtml-kill-begend whole))
1183 ))
1186 ;;; ---------- changing ----------
1187 (defun yahtml-on-assignment-p ()
1188 "Return if current point is on parameter assignment.
1189 If so, return parameter name, otherwise nil.
1190 This function should be able to treat white spaces in value, but not yet."
1191 (let ((p (point)))
1192 (save-excursion
1193 (put 'yahtml-on-assignment-p 'region nil)
1194 (skip-chars-backward "^ \t")
1195 (and (looking-at "\\([A-Za-z0-9]+\\)\\s *=\\s *\"?\\([^ \t\"]+\\)\"?")
1196 (< p (match-end 0))
1197 (>= p (1- (match-beginning 2)))
1198 (put 'yahtml-on-assignment-p 'region
1199 (cons (match-beginning 2) (match-end 2)))
1200 (YaTeX-match-string 1)))))
1202 (defun yahtml-change-begend ()
1203 (let ((tag (yahtml-on-begend-p))
1204 (completion-ignore-case t)
1205 (case-fold-search t)
1206 (p (point)) (q (make-marker))
1207 (default (append yahtml-env-table yahtml-typeface-table))
1208 (user (append yahtml-user-env-table yahtml-user-typeface-table))
1209 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))
1210 href b1 e1)
1211 (cond
1212 (tag
1213 (cond
1214 ((and (string-match "^a$" tag)
1215 (save-excursion
1216 (and
1217 (re-search-backward "<a\\b" nil t)
1218 (progn
1219 (goto-char (match-end 0))
1220 (skip-chars-forward " \t\n")
1221 (setq b1 (point))
1222 (search-forward ">" nil t))
1223 (setq e1 (match-beginning 0))
1224 (goto-char b1)
1225 (re-search-forward "href\\s *=" e1 t)
1226 (>= p (point))
1227 (progn
1228 (goto-char (match-end 0))
1229 (skip-chars-forward " \t\n")
1230 (looking-at "\"?\\([^\"> \t\n]+\\)\"?"))
1231 (< p (match-end 0)))))
1232 (setq b1 (match-beginning 1) e1 (match-end 1)
1233 yahtml-completing-buffer (current-buffer)
1234 ;; yahtml-urls-local is buffer-local, so we must put
1235 ;; that into yahtml-urls here
1236 yahtml-urls (append yahtml-urls-private yahtml-urls-local)
1237 href (read-from-minibuffer
1238 "Change href to: " "" yahtml-url-completion-map))
1239 (if (string< "" href)
1240 (progn
1241 ;;(setq href ;??
1242 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))
1243 (delete-region b1 e1)
1244 (goto-char b1)
1245 (insert href))))
1246 (t
1247 (save-excursion
1248 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))
1249 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))
1250 (skip-chars-forward "^A-Za-z")
1251 (set-marker q (point))
1252 (setq p (point))
1253 (yahtml-goto-corresponding-begend)
1254 (or (= (char-after (point)) ?<)
1255 (skip-chars-backward "^<"))
1256 (skip-chars-forward "^A-Za-z")
1257 (if (= (char-after (1- (point))) ?/)
1258 (progn
1259 (set-marker q (point))
1260 (goto-char p)))
1261 (setq tag (let ((completion-ignore-case t))
1262 (YaTeX-cplread-with-learning
1263 (format "Change `%s' to(default %s): "
1264 tag yahtml-last-begend)
1265 'default 'user 'tmp)))
1266 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
1267 (if (string= "" tag) (setq tag yahtml-last-begend))
1268 (setq yahtml-last-begend
1269 (or (cdr (assoc tag yahtml-env-table)) tag)
1270 tag yahtml-last-begend)
1271 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))
1272 (insert (format "%s%s" tag (yahtml-addin tag)))
1273 (goto-char q)
1274 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
1275 (insert tag))))
1276 t))))
1278 (defun yahtml-change-command ()
1279 (let ((p (point)) (case-fold-search t) cmd par new
1280 (beg (make-marker)) (end (make-marker)))
1281 (skip-chars-backward "^<")
1282 (if (and
1283 (looking-at yahtml-command-regexp)
1284 (progn
1285 (set-marker beg (match-beginning 0))
1286 (set-marker end (match-end 0))
1287 t) ;for further work
1288 (progn
1289 (forward-char -1)
1290 (condition-case nil
1291 (forward-list 1)
1292 (error nil))
1293 (< p (point))))
1294 (progn
1295 (goto-char p)
1296 (if (setq par (yahtml-on-assignment-p))
1297 (progn
1298 (setq new (yahtml-read-parameter par))
1299 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))
1300 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))
1301 (setq new
1302 (YaTeX-cplread-with-learning
1303 "Change form to: "
1304 'yahtml-form-table 'yahtml-user-form-table
1305 'yahtml-tmp-form-table)))
1306 (delete-region beg end)
1307 (goto-char beg)
1308 (insert new)
1309 t)
1310 (goto-char p)
1311 nil)))
1313 (defun yahtml-change-* ()
1314 "Change current position's HTML tag (set)."
1315 (interactive)
1316 (cond
1317 ((yahtml-change-begend))
1318 ((yahtml-change-command))
1319 ))
1321 ;;; ---------- commenting ----------
1322 (defun yahtml-comment-region (&optional uncom)
1323 "Comment out region or environment."
1324 (interactive)
1325 (let (e beg p)
1326 (cond
1327 ((setq e (yahtml-on-begend-p))
1328 (save-excursion
1329 (setq p (point))
1330 (if (string-match "^/" e)
1331 (setq beg (progn (forward-line 1) (point)))
1332 (setq beg (progn (beginning-of-line) (point))))
1333 (goto-char p)
1334 (yahtml-goto-corresponding-begend)
1335 (if (string-match "^/" e)
1336 (beginning-of-line)
1337 (forward-line 1))
1338 (comment-region beg (point) (if uncom (list 4)))))
1339 (t (comment-region (region-beginning) (region-end)
1340 (if uncom (list 4)))))))
1342 (defun yahtml-uncomment-region ()
1343 (interactive)
1344 (yahtml-comment-region t))
1348 (defun yahtml-inner-environment-but (exclude &optional quick)
1349 "Return the inner environment but matches with EXCLUDE tag."
1350 (let (e (case-fold-search t))
1351 (save-excursion
1352 (while (and (setq e (YaTeX-inner-environment quick))
1353 (string-match exclude e))
1354 (goto-char (get 'YaTeX-inner-environment 'point))))
1355 e))
1357 ;;; ---------- filling ----------
1359 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))
1360 (defun yahtml-move-to-column (col &optional force)
1361 (beginning-of-line)
1362 (let ((ccol 0))
1363 (while (and (> col ccol) (not (eolp)))
1364 (if (eq (following-char) ?\<)
1365 (progn
1366 (while (and (not (eq (following-char) ?\>))
1367 (not (eolp)))
1368 (forward-char))
1369 (or (eolp) (forward-char)))
1370 (or (eolp) (forward-char))
1371 (if (eq (preceding-char) ?\t)
1372 (let ((wd (- 8 (% (+ ccol 8) 8))))
1373 (if (and force (< col (+ ccol wd)))
1374 (progn
1375 (backward-char 1)
1376 (insert-char ?\ (- col ccol))
1377 (setq ccol col))
1378 (setq ccol (+ ccol wd))))
1379 (setq ccol (1+ ccol)))
1380 (if (and YaTeX-japan
1381 (string-match "[chj]" (char-category (preceding-char))))
1382 (setq ccol (1+ ccol)))))
1383 (if (and force (> col ccol))
1384 (progn
1385 (insert-char ?\ (- col ccol))
1386 col)
1387 ccol)))
1389 (defun yahtml-fill-paragraph (arg)
1390 (interactive "P")
1391 (let*((case-fold-search t) (p (point))
1392 (e (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t) "html"))
1393 (prep (string-match "^pre$" e))
1394 (ps1 (if prep (default-value 'paragraph-start)
1395 paragraph-start))
1396 (ps2 (if prep (concat (default-value 'paragraph-start)
1397 "\\|^\\s *</?pre>")
1398 paragraph-start)))
1399 (save-excursion
1400 (unwind-protect
1401 (progn
1402 (if prep
1403 (fset 'move-to-column 'yahtml-move-to-column))
1404 (fill-region-as-paragraph
1405 (progn (re-search-backward paragraph-start nil t)
1406 (or (save-excursion
1407 (goto-char (match-beginning 0))
1408 (if (looking-at "<")
1409 (forward-list)
1410 (goto-char (match-end 0))
1411 (skip-chars-forward " \t>"))
1412 (if (looking-at "[ \t]*$")
1413 (progn (forward-line 1) (point))))
1414 (point)))
1415 (progn (goto-char p)
1416 (re-search-forward ps2 nil t)
1417 (match-beginning 0))))
1418 (fset 'move-to-column yahtml-saved-move-to-column)))))
1420 ;(defun yahtml-indent-new-commnet-line ()
1421 ; (unwind-protect
1422 ; (progn
1423 ; (fset 'move-to-column 'yahtml-move-to-column)
1424 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))
1425 ; (fset 'move-to-column yahtml-saved-move-to-column)))
1427 ;;;
1428 ;;; ---------- indentation ----------
1429 ;;;
1430 (defun yahtml-indent-line ()
1431 "Indent a line (faster wrapper)"
1432 (interactive)
1433 (let (indent)
1434 (if (and (save-excursion
1435 (beginning-of-line) (skip-chars-forward "\t ")
1436 (not (looking-at "<")))
1437 (save-excursion
1438 (forward-line -1)
1439 (while (and (not (bobp)) (looking-at "^\\s *$"))
1440 (forward-line -1))
1441 (skip-chars-forward "\t ")
1442 (setq indent (current-column))
1443 (not (looking-at "<"))))
1444 (progn
1445 (save-excursion
1446 (beginning-of-line)
1447 (skip-chars-forward " \t")
1448 (or (= (current-column) indent)
1449 (YaTeX-reindent indent)))
1450 (and (bolp) (skip-chars-forward " \t")))
1451 (yahtml-indent-line-real))))
1453 (defun yahtml-indent-line-real ()
1454 (interactive)
1455 (let ((envs "[uod]l\\|table\\|[ht][rhd0-6]\\|select\\|blockquote\\|center\\|menu\\|dir")
1456 (itemizing-envs "^\\([uod]l\\|menu\\|dir\\)$")
1457 (itms "<\\(dt\\|dd\\|li\\|t[rdh]\\|option\\)\\b")
1458 inenv p col peol (case-fold-search t))
1459 (save-excursion
1460 (beginning-of-line)
1461 (setq inenv (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t)
1462 "html")
1463 col (get 'YaTeX-inner-environment 'indent)
1464 p (get 'YaTeX-inner-environment 'point)
1465 op nil))
1466 (save-excursion
1467 (cond
1468 ((string-match envs inenv)
1469 (save-excursion
1470 (beginning-of-line)
1471 (skip-chars-forward " \t")
1472 (cond ;lookup current line's tag
1473 ((looking-at (concat "</\\(" envs "\\)>"))
1474 (YaTeX-reindent col))
1475 ((looking-at itms)
1476 (YaTeX-reindent (+ col yahtml-environment-indent)))
1477 ((and yahtml-hate-too-deep-indentation
1478 (looking-at (concat "<\\(" envs "\\)")))
1479 (YaTeX-reindent (+ col (* 2 yahtml-environment-indent))))
1480 ((and (< p (point))
1481 (string-match itemizing-envs inenv)
1482 (save-excursion
1483 (and
1484 ;;(re-search-backward itms p t)
1485 (setq op (point))
1486 (goto-char p)
1487 (re-search-forward itms op t)
1488 (progn
1489 (skip-chars-forward "^>")
1490 (skip-chars-forward ">")
1491 (skip-chars-forward " \t")
1492 (setq col (if (looking-at "$")
1493 (+ col yahtml-environment-indent)
1494 (current-column)))))))
1495 (YaTeX-reindent col))
1496 (t
1497 (YaTeX-reindent (+ col yahtml-environment-indent)))))))
1498 (and (bolp) (skip-chars-forward " \t"))
1499 (if (and (setq inenv (yahtml-on-begend-p))
1500 (string-match
1501 (concat "^\\<\\(" yahtml-struct-name-regexp "\\)") inenv))
1502 (save-excursion
1503 (setq peol (point-end-of-line))
1504 (or (= (char-after (point)) ?<)
1505 (progn (skip-chars-backward "^<") (forward-char -1)))
1506 (setq col (current-column))
1507 (if (and (yahtml-goto-corresponding-begend t)
1508 (> (point) peol)) ;if on the different line
1509 (YaTeX-reindent col)))))
1510 (and (bolp) (skip-chars-forward " \t"))))
1512 ;(defun yahtml-fill-item ()
1513 ; "Fill item HTML version"
1514 ; (interactive)
1515 ; (let (inenv p fill-prefix peol (case-fold-search t))
1516 ; (setq inenv (or (YaTeX-inner-environment) "html")
1517 ; p (get 'YaTeX-inner-environment 'point))
1518 ; (cond
1519 ; ((string-match "^[uod]l" inenv)
1520 ; (save-excursion
1521 ; (if (re-search-backward "<\\(d[td]\\|li\\)>[ \t\n]*" p t)
1522 ; (progn
1523 ; (goto-char (match-end 0))
1524 ; (setq col (current-column)))
1525 ; (error "No <li>, <dt>, <dd>")))
1526 ; (save-excursion
1527 ; (end-of-line)
1528 ; (setq peol (point))
1529 ; (newline)
1530 ; (indent-to-column col)
1531 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))
1532 ; (delete-region (point) peol)
1533 ; (fill-region-as-paragraph
1534 ; (progn (re-search-backward paragraph-start nil t) (point))
1535 ; (progn (re-search-forward paragraph-start nil t 2)
1536 ; (match-beginning 0)))))
1537 ; (t nil))))
1539 ;;;
1540 ;;; ---------- Lint and Browsing ----------
1541 ;;;
1542 (defun yahtml-browse-menu ()
1543 "Browsing menu"
1544 (interactive)
1545 (message "J)weblint p)Browse R)eload...")
1546 (let ((c (char-to-string (read-char))))
1547 (cond
1548 ((string-match "j" c)
1549 (yahtml-lint-buffer (current-buffer)))
1550 ((string-match "[bp]" c)
1551 (yahtml-browse-current-file))
1552 ((string-match "r" c)
1553 (yahtml-browse-reload)))))
1555 (defvar yahtml-lint-buffer "*weblint*")
1557 (defun yahtml-lint-buffer (buf)
1558 "Call lint on buffer BUF."
1559 (require 'yatexprc)
1560 (interactive "bCall lint on buffer: ")
1561 (setq buf (get-buffer buf))
1562 (YaTeX-save-buffers)
1563 (YaTeX-typeset
1564 (concat yahtml-lint-program " "
1565 (file-name-nondirectory (buffer-file-name buf)))
1566 yahtml-lint-buffer "lint" "lint"))
1568 (defun yahtml-file-to-url (file)
1569 "Convert local unix file name to URL.
1570 If no matches found in yahtml-path-url-alist, return raw file name."
1571 (let ((list yahtml-path-url-alist) p url)
1572 (if (file-directory-p file)
1573 (setq file (expand-file-name yahtml-directory-index file))
1574 (setq file (expand-file-name file)))
1575 (if (string-match "^[A-Za-z]:/" file)
1576 (progn
1577 ;; (aset file 1 ?|) ;これは要らないらしい…
1578 (setq file (concat "///" file))))
1579 (while list
1580 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)
1581 (setq url (cdr (car list))
1582 file (substring file (match-end 0))
1583 url (concat url file)
1584 list nil))
1585 (setq list (cdr list)))
1586 (or url (concat "file:" file))))
1588 (defun yahtml-url-to-path (file &optional basedir)
1589 "Convert local URL name to unix file name."
1590 (let ((list yahtml-path-url-alist) url realpath docroot
1591 (dirsufp (string-match "/$" file)))
1592 (setq basedir (or basedir
1593 (file-name-directory
1594 (expand-file-name default-directory))))
1595 (cond
1596 ((string-match "^/" file)
1597 (while list
1598 (if (file-directory-p (car (car list)))
1599 (progn
1600 (setq url (cdr (car list)))
1601 (if (string-match "\\(http://[^/]*\\)/" url)
1602 (setq docroot (substring url (match-end 1)))
1603 (setq docroot url))
1604 (cond
1605 ((string-match (concat "^" (regexp-quote docroot)) file)
1606 (setq realpath
1607 (expand-file-name
1608 (substring
1609 file
1610 (if (= (aref file (1- (match-end 0))) ?/)
1611 (match-end 0) ; "/foo"
1612 (min (1+ (match-end 0)) (length file)))) ; "/~foo"
1613 (car (car list))))))
1614 (if realpath
1615 (progn (setq list nil)
1616 (if (and dirsufp (not (string-match "/$" realpath)))
1617 (setq realpath (concat realpath "/")))))))
1618 (setq list (cdr list)))
1619 realpath)
1620 (t file))))
1622 (defun yahtml-browse-current-file ()
1623 "Call WWW browser on current file."
1624 (interactive)
1625 (basic-save-buffer)
1626 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))
1628 (defun yahtml-browse-reload ()
1629 "Send `reload' event to netzscape."
1630 (let ((pb "* WWW Browser *") (cb (current-buffer)))
1631 (cond
1632 ((string-match "[Nn]etscape" yahtml-www-browser)
1633 (if (get-buffer pb)
1634 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1635 ;;(or (get 'yahtml-netscape-sentinel 'url)
1636 ;; (error "Reload should be called after Browsing."))
1637 (put 'yahtml-netscape-sentinel 'url
1638 (yahtml-file-to-url (buffer-file-name)))
1639 (basic-save-buffer)
1640 (set-process-sentinel
1641 (setq yahtml-browser-process
1642 (start-process
1643 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
1644 (format "%s -remote 'reload'" yahtml-www-browser)))
1645 'yahtml-netscape-sentinel))
1646 (t
1647 (message "Sorry, RELOAD is supported only for Netscape.")))))
1649 ;;; ---------- Intelligent newline ----------
1650 (defun yahtml-intelligent-newline (arg)
1651 "Intelligent newline for HTML"
1652 (interactive "P")
1653 (let (env func)
1654 (end-of-line)
1655 (setq env (downcase (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t)
1656 "html")))
1657 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))
1658 (newline)
1659 (if (and env func (fboundp func))
1660 ;; if intelligent line function is defined, call that
1661 (funcall func)
1662 ;; else do the default action
1663 (if (string-match yahtml-p-prefered-env-regexp env)
1664 (yahtml-insert-p)))))
1666 (defvar yahtml-faithful-to-htmllint nil)
1667 (defun yahtml-intelligent-newline-ul ()
1668 (interactive)
1669 (yahtml-insert-single "li")
1670 (or yahtml-faithful-to-htmllint (insert " "))
1671 (yahtml-indent-line))
1673 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)
1675 (defun yahtml-intelligent-newline-dl ()
1676 (interactive)
1677 (let ((case-fold-search t))
1678 (if (save-excursion
1679 (re-search-backward "<\\(\\(dt\\)\\|\\(dd\\)\\)>"
1680 (get 'YaTeX-inner-environment 'point) t))
1681 (cond
1682 ((match-beginning 2)
1683 (yahtml-insert-single "dd")
1684 (or yahtml-faithful-to-htmllint (insert " "))
1685 (setq yahtml-last-single-cmd "dt"))
1686 ((match-beginning 3)
1687 (yahtml-insert-single "dt")
1688 (or yahtml-faithful-to-htmllint (insert " "))
1689 (setq yahtml-last-single-cmd "dd")))
1690 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))
1691 (setq yahtml-last-single-cmd "dd"))
1692 (yahtml-indent-line)
1693 (and (string-match yahtml-p-prefered-env-regexp "dl")
1694 (string-equal yahtml-last-single-cmd "dt")
1695 (yahtml-insert-p nil))))
1697 (defun yahtml-intelligent-newline-select ()
1698 (interactive)
1699 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")
1700 (yahtml-indent-line))
1702 ;;; ---------- Marking ----------
1703 (defun yahtml-mark-begend ()
1704 "Mark current tag"
1705 (interactive)
1706 (YaTeX-beginning-of-environment)
1707 (let ((p (point)))
1708 (save-excursion
1709 (skip-chars-backward " \t" (point-beginning-of-line))
1710 (if (bolp) (setq p (point))))
1711 (push-mark p t))
1712 (yahtml-goto-corresponding-begend)
1713 (forward-list 1)
1714 (if (eolp) (forward-char 1)))
1716 ;;; ---------- complete marks ----------
1717 (defun yahtml-complete-mark ()
1718 "Complete >, <, &ersand, and "e."
1719 (interactive)
1720 (message "1:< 2:> 3:& 4:\"")
1721 (let ((c (read-char)))
1722 (setq c (if (or (< c ?0) (> c ?5))
1723 (string-match (regexp-quote (char-to-string c)) "<>&\"")
1724 (- c ?1)))
1725 (if (or (< c 0) (> c 4))
1726 nil
1727 (insert (format "&%s;" (nth c '("lt" "gt" "amp" "quot")))))))
1730 ;;; ---------- jump to error line ----------
1731 (defvar yahtml-error-line-regexp
1732 "^\\(.*\\)(\\([0-9]+\\)):"
1733 "*Regexp of error position which is produced by lint program.")
1734 (defun yahtml-prev-error ()
1735 "Jump to previous error seeing lint buffer."
1736 (interactive)
1737 (or (get-buffer yahtml-lint-buffer)
1738 (error "No lint program ran."))
1739 (YaTeX-showup-buffer yahtml-lint-buffer nil t)
1740 (yahtml-jump-to-error-line t))
1742 (defun yahtml-jump-to-error-line (&optional sit)
1743 (interactive "P")
1744 (let ((p (point)) (e (point-end-of-line)))
1745 (end-of-line)
1746 (if (re-search-backward yahtml-error-line-regexp nil t)
1747 (let ((f (YaTeX-match-string 1))
1748 (l (string-to-int (YaTeX-match-string 2))))
1749 (if sit (sit-for 1))
1750 (forward-line -1)
1751 (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)
1752 (goto-line l))
1753 (message "No line number usage"))))
1755 ;;; ---------- ----------
1757 ;;;
1758 ;;hilit19
1759 ;;;
1760 (defvar yahtml-default-face-table
1761 '(
1762 (form black/ivory white/hex-442233 italic)
1763 ))
1764 (defvar yahtml-hilit-patterns-alist
1765 '(
1766 ;; comments
1767 ("<!--\\s " "-->" comment)
1768 ;; include&exec
1769 ("<!--#\\(include\\|exec\\)" "-->" include)
1770 ;; string
1771 (hilit-string-find 39 string)
1772 (yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
1773 ("</?[uod]l>" 0 decl)
1774 ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
1775 ("<a\\s +href" "</a>" crossref)
1776 (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
1777 ))
1779 (defun yahtml-hilit-region-tag (tag)
1780 "Return list of start/end point of <TAG> form."
1781 (if (re-search-forward (concat "<" tag ">") nil t)
1782 (let ((m0 (match-beginning 0)))
1783 (skip-chars-forward " \t\n")
1784 (cons (point)
1785 (progn (re-search-forward (concat "</" tag ">") nil t)
1786 (match-beginning 0))))))
1788 (defun yahtml-hilit-region-tag-itself (ptn)
1789 "Return list of start/end point of <tag options...> itself."
1790 (if (re-search-forward ptn nil t)
1791 (let ((m0 (match-beginning 0)))
1792 (skip-chars-forward "^>")
1793 (cons m0 (1+ (point) )))))
1795 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))
1796 (and (featurep 'hilit19)
1797 (or (assq 'yahtml-mode hilit-patterns-alist)
1798 (setq hilit-patterns-alist
1799 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
1800 hilit-patterns-alist))))
1802 (provide 'yahtml)
1804 ; Local variables:
1805 ; fill-prefix: ";;; "
1806 ; paragraph-start: "^$\\| \\|;;;$"
1807 ; paragraph-separate: "^$\\| \\|;;;$"
1808 ; End: