yatex
view yahtml.el @ 61:b9f753846b6b
Bug fix release
| author | yuuji |
|---|---|
| date | Mon, 07 Apr 1997 20:07:48 +0000 |
| parents | 9e08ed569d80 |
| children | 36a48185b95a |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; (c ) 1994-1997 by HIROSE Yuuji [yuuji@ae.keio.ac.jp]
3 ;;; Last modified Mon Apr 7 16:58:32 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 ;;;[Commentary]
22 ;;;
23 ;;; It is assumed you are already familiar with YaTeX. The following
24 ;;; completing featureas are available: ([prefix] means `C-c' by default)
25 ;;;
26 ;;; * [prefix] b X Complete environments such as `H1' which
27 ;;; normally requires closing tag `</H1>
28 ;;; <a href=foo> ... </a> is also classified into
29 ;;; this group
30 ;;; When input `href=...', you can complete file
31 ;;; name or label(href="#foo") by typing TAB.
32 ;;; * [prefix] s Complete declarative notations such as
33 ;;; `<img src="foo.gif">'
34 ;;; `<input name="var" ...>'
35 ;;; * [prefix] l Complete typeface-changing commands such as
36 ;;; `<i> ... </i>' or `<samp> ... </samp>'
37 ;;; This completion can be used to make in-line
38 ;;; tags which is normally completed with [prefix] b.
39 ;;; * [prefix] m Complete single commands such as
40 ;;; `<br>' or `<hr> or <li>...'
41 ;;; * M-RET Intelligent newline; if current TAG is one of
42 ;;; ul, ol, or dl. insert newline and <li> or
43 ;;; <dt> or <dd> suitable for current condition.
44 ;;; * menu-bar yahtml Complete all by selecting a menu item (Though I
45 ;;; hate menu, this is most useful)
46 ;;; * [prefix] g Goto corresponding Tag or HREF such as
47 ;;; <dl> <-> </dl> or href="xxx".
48 ;;; Or invoke image viewer if point is on <img src=...>.
49 ;;; * [prefix] k Kill html tags on the point. If you provide
50 ;;; universal-argument, kill surrounded contents too.
51 ;;; * [prefix] c Change html tags on the point.
52 ;;; When typeing [prefix] c on `href="xxx"', you can
53 ;;; change the reference link with completion.
54 ;;; * [prefix] t j Call weblint on current file.
55 ;;; * [prefix] t p View current html with WWW browser
56 ;;; (To activate this, never fail to set the lisp
57 ;;; variable yahtml-www-browser. Recommended value
58 ;;; is "netscape")
59 ;;; * [prefix] a YaTeX's accent mark's equivalent of yahtml.
60 ;;; This function can input $lt, $gt or so.
61 ;;;
64 (require 'yatex)
65 ;;; --- customizable variable starts here ---
66 (defvar yahtml-image-viewer "xv" "*Image viewer program")
67 (defvar yahtml-www-browser "netscape"
68 "*WWW Browser command")
69 (defvar yahtml-kanji-code 2
70 "Kanji coding system of html file; 1=sjis, 2=jis, 3=euc")
71 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")
72 (defvar yahtml-path-url-alist nil
73 "*Alist of unix path name vs. URL name of WWW server.
74 Ex.
75 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")
76 (\"/usr/home/yuuji/darts/http\" . \"http://inspire.comp.ae.keio.ac.jp/~darts\"))")
77 (defvar yahtml-directory-index "index.html"
78 "*Directory index file name;
79 Consult your site's WWW administrator.")
81 (defvar yahtml-environment-indent YaTeX-environment-indent
82 "*Indentation depth of HTML's listing environment")
84 (defvar yahtml-lint-program (if YaTeX-japan "jweblint" "weblint")
85 "*Program name to lint HTML file")
86 (defvar yahtml-hate-too-deep-indentation nil
87 "*Non-nil for this variable suppress deep indentation in listing environments.")
89 ;;; --- customizable variable ends here ---
91 (defvar yahtml-prefix-map nil)
92 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")
93 (defvar yahtml-lint-buffer-map nil "Keymap used in lint buffer.")
94 (defvar yahtml-shell-command-option
95 (or (and (boundp 'shell-command-option) shell-command-option)
96 (if (eq system-type 'ms-dos) "/c" "-c")))
99 (defun yahtml-define-begend-key-normal (key env &optional map)
100 "Define short cut yahtml-insert-begend key."
101 (YaTeX-define-key
102 key
103 (list 'lambda '(arg) '(interactive "P")
104 (list 'yahtml-insert-begend 'arg env))
105 map))
107 (defun yahtml-define-begend-region-key (key env &optional map)
108 "Define short cut yahtml-insert-begend-region key."
109 (YaTeX-define-key key (list 'lambda nil '(interactive)
110 (list 'yahtml-insert-begend t env)) map))
112 (defun yahtml-define-begend-key (key env &optional map)
113 "Define short cut key for begin type completion both for
114 normal and region mode. To customize yahtml, user should use this function."
115 (yahtml-define-begend-key-normal key env map)
116 (if YaTeX-inhibit-prefix-letter nil
117 (yahtml-define-begend-region-key
118 (concat (upcase (substring key 0 1)) (substring key 1)) env map)))
121 (if yahtml-mode-map nil
122 (setq yahtml-mode-map (make-sparse-keymap)
123 yahtml-prefix-map (make-sparse-keymap))
124 (define-key yahtml-mode-map YaTeX-prefix yahtml-prefix-map)
125 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)
126 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)
127 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))
128 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)
129 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)
130 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)
131 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)
132 (define-key yahtml-mode-map YaTeX-prefix yahtml-prefix-map)
133 (let ((map yahtml-prefix-map))
134 (YaTeX-define-key "^" 'yahtml-visit-main map)
135 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)
136 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)
137 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)
138 (and YaTeX-emacs-19 window-system
139 (progn
140 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
141 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
142 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
143 (YaTeX-define-key "v" 'YaTeX-version map)
144 (YaTeX-define-key "}" 'YaTeX-insert-braces-region map)
145 (YaTeX-define-key "]" 'YaTeX-insert-brackets-region map)
146 (YaTeX-define-key ")" 'YaTeX-insert-parens-region map)
147 (YaTeX-define-key "s" 'yahtml-insert-form map)
148 (YaTeX-define-key "l" 'yahtml-insert-tag map)
149 (YaTeX-define-key "L" 'yahtml-insert-tag-region map)
150 (YaTeX-define-key "m" 'yahtml-insert-single map)
151 (YaTeX-define-key "n" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<BR>" "<br>"))) map)
152 (YaTeX-define-key "-" '(lambda () (interactive) (insert (if yahtml-prefer-upcases "<HR>" "<hr>") "\n")) map)
153 (if YaTeX-no-begend-shortcut
154 (progn
155 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)
156 (YaTeX-define-key "b" 'yahtml-insert-begend map))
157 (yahtml-define-begend-key "bh" "html" map)
158 (yahtml-define-begend-key "bH" "head" map)
159 (yahtml-define-begend-key "bt" "title" map)
160 (yahtml-define-begend-key "bT" "table" map)
161 (yahtml-define-begend-key "bb" "body" map)
162 (yahtml-define-begend-key "bc" "center" map)
163 (yahtml-define-begend-key "bd" "dl" map)
164 (yahtml-define-begend-key "bu" "ul" map)
165 (yahtml-define-begend-key "b1" "h1" map)
166 (yahtml-define-begend-key "b2" "h2" map)
167 (yahtml-define-begend-key "b3" "h3" map)
168 (yahtml-define-begend-key "ba" "a" map)
169 (yahtml-define-begend-key "bf" "form" map)
170 (yahtml-define-begend-key "bs" "select" map)
171 (YaTeX-define-key "b " 'yahtml-insert-begend map)
172 (YaTeX-define-key "B " 'yahtml-insert-begend-region map)
173 )
174 (YaTeX-define-key "e" 'YaTeX-end-environment map)
175 (YaTeX-define-key ">" 'yahtml-comment-region map)
176 (YaTeX-define-key "<" 'yahtml-uncomment-region map)
177 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)
178 (YaTeX-define-key "k" 'yahtml-kill-* map)
179 (YaTeX-define-key "c" 'yahtml-change-* map)
180 (YaTeX-define-key "t" 'yahtml-browse-menu map)
181 (YaTeX-define-key "a" 'yahtml-complete-mark map)
182 (YaTeX-define-key "'" 'yahtml-prev-error map)
183 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
184 ))
186 (if yahtml-lint-buffer-map nil
187 (setq yahtml-lint-buffer-map (make-keymap))
188 (define-key yahtml-lint-buffer-map " " 'yahtml-jump-to-error-line))
191 (defvar yahtml-paragraph-start
192 (concat
193 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|[bhtd][rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\)\\b")
194 "*Regexp of html paragraph separater")
195 (defvar yahtml-paragraph-separate
196 (concat
197 "^$\\|<!--\\|^[ \t]*</?\\(h[1-6]\\|p\\|[bhtd][ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\|table\\|center\\|blockquote\\|!--\\)\\b")
198 "*Regexp of html paragraph separater")
199 (defvar yahtml-syntax-table nil
200 "*Syntax table for typesetting buffer")
202 (if yahtml-syntax-table nil
203 (setq yahtml-syntax-table
204 (make-syntax-table (standard-syntax-table)))
205 (modify-syntax-entry ?\< "(>" yahtml-syntax-table)
206 (modify-syntax-entry ?\> ")<" yahtml-syntax-table)
207 (modify-syntax-entry ?\n " " yahtml-syntax-table)
208 )
209 (defvar yahtml-command-regexp "[A-Za-z0-9]+"
210 "Regexp of constituent of html commands.")
212 ;;; Completion tables for `form'
213 (defvar yahtml-form-table
214 '(("img") ("input")))
215 (defvar yahtml-user-form-table nil)
216 (defvar yahtml-tmp-form-table nil)
218 (defvar yahtml-env-table
219 '(("html") ("head") ("title") ("body") ("dl") ("ul") ("ol") ("pre")
220 ("a") ("form") ("select") ("center") ("textarea") ("blockquote")
221 ("OrderedList" . "ol")
222 ("UnorderedList" . "ul")
223 ("DefinitionList" . "dl")
224 ("Preformatted" . "pre")
225 ("table") ("tr") ("th") ("td")
226 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6")
227 ("p")))
229 (defvar yahtml-itemizing-regexp
230 "\\(ul\\|ul\\|dl\\)"
231 "Regexp of itemizing forms")
233 (defvar yahtml-user-env-table nil)
234 (defvar yahtml-tmp-env-table nil)
236 ;;; Completion tables for typeface designator
237 (defvar yahtml-typeface-table
238 (append
239 '(("dfn") ("em") ("cite") ("code") ("kbd") ("samp")
240 ("strong") ("var") ("b") ("i") ("tt") ("u") ("address"))
241 yahtml-env-table)
242 "Default completion table of typeface designator")
243 (defvar yahtml-user-typeface-table nil)
244 (defvar yahtml-tmp-typeface-table nil)
245 (defvar yahtml-last-typeface-cmd "address")
247 (defvar yahtml-single-cmd-table
248 '(("hr") ("br") ("option") ("p")
249 ("HorizontalLine" . "hr")
250 ("BreakLine" . "br")
251 ("Paragraph" . "p")
252 ("Item" . "li")
253 ("DefineTerm" . "dt")
254 ("Description" . "dd")
255 ("dd") ("dt") ("li")
256 )
257 "Default completion table of HTML single command.")
258 (defvar yahtml-user-single-cmd-table nil)
259 (defvar yahtml-tmp-single-cmd-table nil)
260 (defvar yahtml-last-single-cmd nil)
262 (defvar yahtml-prefer-upcases nil)
264 ;(defvar yahtml-struct-name-regexp
265 ; "\\<\\(h[1-6]\\|[uod]l\\|html\\|body\\|title\\|head\\|table\\|t[rhd]\\|pre\\|a\\|form\\|select\\|center\\|blockquote\\)\\b")
266 (defvar yahtml-struct-name-regexp
267 (concat
268 "\\<\\("
269 (mapconcat (function (lambda (x) (car x))) yahtml-typeface-table "\\|")
270 "\\)\\b")
271 "Regexp of structure beginning.")
273 (defun yahtml-mode ()
274 (interactive)
275 (yatex-mode)
276 (cond
277 ((boundp 'MULE)
278 (set-file-coding-system
279 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))))
280 ((boundp 'NEMACS)
281 (make-local-variable 'kanji-fileio-code)
282 (setq kanji-fileio-code yahtml-kanji-code)))
283 (setq major-mode 'yahtml-mode
284 mode-name "yahtml")
285 (make-local-variable 'YaTeX-kanji-code)
286 (make-local-variable 'YaTeX-ec) (setq YaTeX-ec "")
287 (make-local-variable 'YaTeX-struct-begin)
288 (setq YaTeX-struct-begin "<%1%2")
289 (make-local-variable 'YaTeX-struct-end) (setq YaTeX-struct-end "</%1>")
290 (make-local-variable 'YaTeX-struct-name-regexp)
291 (setq YaTeX-struct-name-regexp yahtml-struct-name-regexp)
292 (make-local-variable 'YaTeX-prefix-map)
293 (make-local-variable 'YaTeX-command-token-regexp)
294 (setq YaTeX-command-token-regexp yahtml-command-regexp)
295 (make-local-variable 'YaTeX-comment-prefix)
296 (setq YaTeX-comment-prefix "<!--")
297 ;;(make-local-variable 'YaTeX-environment-indent)
298 ;;(setq YaTeX-environment-indent 0)
299 (make-local-variable 'fill-prefix)
300 (setq fill-prefix nil)
301 (make-local-variable 'paragraph-separate)
302 (setq paragraph-start yahtml-paragraph-start
303 paragraph-separate yahtml-paragraph-separate)
304 (make-local-variable 'comment-start)
305 (make-local-variable 'comment-end)
306 (setq comment-start "<!-- " comment-end " -->")
307 (make-local-variable 'indent-line-function)
308 (setq indent-line-function 'yahtml-indent-line)
309 (make-local-variable 'YaTeX-item-regexp)
310 (setq YaTeX-item-regexp "<\\(li\\|d[td]\\)>")
311 (make-local-variable 'YaTeX-typesetting-mode-map)
312 (setq YaTeX-typesetting-mode-map yahtml-lint-buffer-map)
313 (set-syntax-table yahtml-syntax-table)
314 (use-local-map yahtml-mode-map)
315 (run-hooks 'yahtml-mode-hook))
317 (defun yahtml-define-menu (keymap bindlist)
318 (mapcar
319 (function
320 (lambda (bind)
321 (define-key keymap (vector (car bind)) (cdr bind))))
322 bindlist))
324 (defvar yahtml-menu-map nil "Menu map of yahtml")
325 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")
326 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")
327 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")
328 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")
330 ;;; Variables for mosaic url history
331 (defvar yahtml-urls nil "Alist of global history")
332 (defvar yahtml-url-history-file "~/.mosaic-global-history"
333 "File name of url history")
335 (cond
336 ((and YaTeX-emacs-19 (null yahtml-menu-map))
337 (setq yahtml-menu-map (make-sparse-keymap "yahtml menu"))
338 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))
339 (yahtml-define-menu
340 yahtml-menu-map-sectioning
341 (nreverse
342 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))
343 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))
344 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))
345 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))
346 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))
347 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))
348 )))
349 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))
350 (yahtml-define-menu
351 yahtml-menu-map-logical
352 (nreverse
353 '((em "Embolden" .
354 (lambda () (interactive) (yahtml-insert-tag nil "EM")))
355 (dfn "Define a word" .
356 (lambda () (interactive) (yahtml-insert-tag nil "DFN")))
357 (cite "Citation" .
358 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))
359 (code "Code" .
360 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))
361 (kbd "Keyboard" .
362 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))
363 (samp "Sample display" .
364 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))
365 (strong "Strong" .
366 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))
367 (VAR "Variable notation" .
368 (lambda () (interactive) (yahtml-insert-tag nil "VAR")))
369 )))
370 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))
371 (yahtml-define-menu
372 yahtml-menu-map-typeface
373 (nreverse
374 '((b "Bold" .
375 (lambda () (interactive) (yahtml-insert-tag nil "B")))
376 (i "Italic" .
377 (lambda () (interactive) (yahtml-insert-tag nil "I")))
378 (tt "Typewriter" .
379 (lambda () (interactive) (yahtml-insert-tag nil "TT")))
380 (u "Underlined" .
381 (lambda () (interactive) (yahtml-insert-tag nil "U")))
382 )))
383 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))
384 (yahtml-define-menu
385 yahtml-menu-map-listing
386 (nreverse
387 '((ul "Unordered" .
388 (lambda () (interactive) (yahtml-insert-begend nil "UL")))
389 (ol "Ordered" .
390 (lambda () (interactive) (yahtml-insert-begend nil "OL")))
391 (dl "Definition" .
392 (lambda () (interactive) (yahtml-insert-begend nil "DL")))
393 )))
394 (setq yahtml-menu-map-item (make-sparse-keymap "item"))
395 (yahtml-define-menu
396 yahtml-menu-map-item
397 (nreverse
398 '((li "Simple item" .
399 (lambda () (interactive) (yahtml-insert-single "li")))
400 (dt "Define term" .
401 (lambda () (interactive) (yahtml-insert-single "dt")))
402 (dd "Description of term" .
403 (lambda () (interactive) (yahtml-insert-single "dd")))
404 )))
405 (define-key yahtml-mode-map [menu-bar yahtml]
406 (cons "yahtml" yahtml-menu-map))
407 (let ((keys (where-is-internal 'fill-paragraph global-map)))
408 (while keys
409 (define-key yahtml-mode-map (car keys) 'yahtml-fill-paragraph)
410 (setq keys (cdr keys))))
411 (yahtml-define-menu
412 yahtml-menu-map
413 (nreverse
414 (list
415 (cons (list 'sect "Sectioning")
416 (cons "sectioning" yahtml-menu-map-sectioning))
417 (cons (list 'list "Listing")
418 (cons "Listing" yahtml-menu-map-listing))
419 (cons (list 'item "Item")
420 (cons "Itemizing" yahtml-menu-map-item));;;
421 (cons (list 'logi "Logical tags")
422 (cons "logical" yahtml-menu-map-logical))
423 (cons (list 'type "Typeface tags")
424 (cons "typeface" yahtml-menu-map-typeface))
425 )))
426 ))
428 (defun yahtml-collect-url-history ()
429 "Collect urls from global history file."
430 (interactive)
431 (save-excursion
432 (set-buffer
433 (find-file-noselect (expand-file-name yahtml-url-history-file)))
434 (goto-char (point-min))
435 (setq yahtml-urls)
436 (message "Collecting global history...")
437 (while (re-search-forward "^[A-Za-z]+:" nil t)
438 (setq yahtml-urls
439 (cons (list
440 (buffer-substring
441 (progn (beginning-of-line) (point))
442 (progn (skip-chars-forward "^ ") (point))))
443 yahtml-urls)))
444 (message "Collecting global history...Done")))
446 ;;; ----------- Completion ----------
447 (defvar yahtml-last-begend "html")
448 (defun yahtml-insert-begend (&optional region env)
449 "Insert <cmd> ... </cmd>."
450 (interactive "P")
451 (let*((completion-ignore-case t)
452 (cmd
453 (or env
454 (YaTeX-cplread-with-learning
455 (format "Environment(default %s): " yahtml-last-begend)
456 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))
457 (bolp (save-excursion
458 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))
459 (cc (current-column)))
460 (if (string< "" cmd) (setq yahtml-last-begend cmd))
461 (setq yahtml-last-begend
462 (or (cdr (assoc yahtml-last-begend yahtml-env-table))
463 yahtml-last-begend))
464 (setq cmd yahtml-last-begend)
465 (if yahtml-prefer-upcases (setq cmd (upcase cmd)))
466 (if region
467 (let ((beg (region-beginning))
468 (end (region-end))
469 (addin (yahtml-addin cmd)))
470 (goto-char end)
471 (insert (format "</%s>%s" cmd (if bolp "\n" "")))
472 (goto-char beg)
473 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" ""))))
474 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))
475 (save-excursion
476 (insert "\n")
477 (indent-to-column cc)
478 (insert (format "</%s>" cmd)))
479 (yahtml-intelligent-newline nil))))
481 (defun yahtml-insert-begend-region ()
482 "Call yahtml-insert-begend in the region mode."
483 (interactive)
484 (yahtml-insert-begend t))
487 (defun yahtml-insert-form (&optional form)
488 "Insert <FORM option=\"argument\">."
489 (interactive)
490 (or form
491 (let ((completion-ignore-case t))
492 (setq form
493 (YaTeX-cplread-with-learning
494 "Form: "
495 'yahtml-form-table 'yahtml-user-form-table
496 'yahtml-tmp-form-table))))
497 (let ((p (point)) q)
498 (if yahtml-prefer-upcases (setq form (upcase form)))
499 (insert (format "<%s%s>" form (yahtml-addin form)))
500 ;;(indent-relative-maybe)
501 (if (cdr (assoc form yahtml-form-table))
502 (save-excursion (insert (format "</%s>" form))))
503 (if (search-backward "\"\"" p t) (forward-char 1))))
505 ;;; ---------- Add-in ----------
506 (defun yahtml-addin (form)
507 "Check add-in function's existence and call it if exists."
508 (let ((addin (concat "yahtml:" (downcase form))) s)
509 (if (and (intern-soft addin) (fboundp (intern-soft addin))
510 (stringp (setq s (funcall (intern addin))))
511 (string< "" s))
512 (concat " " s)
513 "")))
516 (defvar yahtml-completing-buffer nil)
517 (defun yahtml-collect-labels (&optional file)
518 "Collect current buffers label (<a name=...>).
519 If optional argument FILE is specified collect labels in FILE."
520 (let (list bound)
521 (save-excursion
522 (set-buffer yahtml-completing-buffer)
523 (if file (let (hilit-auto-highlight)
524 (set-buffer (find-file-noselect file))))
525 (save-excursion
526 (goto-char (point-min))
527 (while (re-search-forward "<a\\b" nil t)
528 (setq bound (match-end 0))
529 (search-forward ">" nil t)
530 (if (and (re-search-backward "\\(name\\|id\\)=" bound t)
531 (goto-char (match-end 0))
532 (skip-chars-forward " \t\n")
533 (looking-at "\"?#?\\([^\">]+\\)\"?\\b"))
534 (setq list (cons
535 (list (concat "#" (YaTeX-match-string 1)))
536 list))))
537 list)))
538 )
540 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")
541 (if yahtml-url-completion-map nil
542 (setq yahtml-url-completion-map
543 (copy-keymap minibuffer-local-completion-map))
544 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)
545 (define-key yahtml-url-completion-map " " 'yahtml-complete-url)
546 )
548 (defun yahtml-complete-url ()
549 "Complete external URL from history or local file name."
550 (interactive)
551 (let (initial i2 cmpl path dir file listfunc beg labels (p (point)))
552 (setq initial (buffer-string))
553 (cond
554 ((string-match "^http:" initial)
555 (setq cmpl (try-completion initial yahtml-urls)
556 listfunc (list 'lambda nil
557 (list 'all-completions initial 'yahtml-urls))
558 beg (point-min)))
559 ((setq beg (string-match "#" initial))
560 (or (equal beg 0) ;begin with #
561 (progn
562 (setq path (substring initial 0 beg))
563 (if (string-match "^/" path)
564 (setq path (yahtml-url-to-path path)))))
565 (setq initial (substring initial beg))
566 (setq labels (yahtml-collect-labels path)
567 cmpl (try-completion initial labels)
568 listfunc (list 'lambda ()
569 (list 'all-completions
570 initial (list 'quote labels)))
571 beg (+ (point-min) beg)))
572 (t
573 (setq path (if (string-match "^/" initial)
574 (yahtml-url-to-path initial)
575 initial))
576 (setq dir (or (file-name-directory path) ".")
577 file (file-name-nondirectory path)
578 initial file
579 cmpl (file-name-completion file dir)
580 listfunc (list 'lambda nil
581 (list 'file-name-all-completions
582 file dir))
583 beg (save-excursion (skip-chars-backward "^/") (point)))))
584 (cond
585 ((stringp cmpl)
586 (if (string= initial cmpl)
587 (with-output-to-temp-buffer "*Completions*"
588 (princ "Possible completinos are:\n")
589 (princ
590 (mapconcat '(lambda (x) x) (funcall listfunc) "\n")))
591 (delete-region (point) beg)
592 (insert cmpl)))
593 ((null cmpl)
594 (ding))
595 ((eq t cmpl)
596 (save-excursion
597 (unwind-protect
598 (progn
599 (goto-char p)
600 (insert " [Sole completion]"))
601 (delete-region p (point-max))))))))
603 (defun yahtml:a ()
604 "Add-in function for <a>"
605 (let ((l yahtml-prefer-upcases))
606 (or yahtml-urls (yahtml-collect-url-history))
607 (setq yahtml-completing-buffer (current-buffer))
608 ; (concat "href=\""
609 ; (completing-read "href: " yahtml-urls)
610 ; "\"")
611 (message "(H)ref (N)ame?")
612 (cond
613 ((string-match "[nN]" (char-to-string (read-char)))
614 (concat (if l "NAME" "name") "=\"" (read-string "name: ") "\""))
615 (t
616 (concat (if l "HREF" "href") "=\""
617 (read-from-minibuffer "href: " "" yahtml-url-completion-map)
618 "\"")))))
620 (defvar yahtml-parameters-completion-alist
621 '(("align" ("top") ("middle") ("bottom") ("left") ("right") ("center"))
622 ("src" . file)
623 ("method" ("POST") ("GET"))))
625 (defun yahtml-read-parameter (par)
626 (let* ((alist (cdr-safe (assoc (downcase par)
627 yahtml-parameters-completion-alist)))
628 (prompt (concat par ": "))
629 v)
630 (cond
631 ((eq alist 'file)
632 (read-file-name prompt "" nil nil ""))
633 (alist
634 (completing-read prompt alist))
635 (t
636 (read-string prompt)))))
639 (defun yahtml:img ()
640 "Add-in function for <img>"
641 (or yahtml-urls (yahtml-collect-url-history))
642 (let ((src (yahtml-read-parameter "src"))
643 (alg (yahtml-read-parameter "align"))
644 (alt (yahtml-read-parameter "alt"))
645 (l yahtml-prefer-upcases))
646 (concat (if l "SRC" "src") "=\"" src "\""
647 (if (string< "" alg)
648 (concat " " (if l "ALIGN" "align") "=\"" alg "\""))
649 (if (string< "" alt)
650 (concat " " (if l "ALT" "alt") "=\"" alt "\"")))))
652 (defun yahtml:form ()
653 "Add-in function `form' input format"
654 (concat
655 " " (if yahtml-prefer-upcases "METHOD" "method=")
656 (completing-read "Method: " '(("POST") ("GET")) nil t)
657 " " (if yahtml-prefer-upcases "ACTION" "action") "=\""
658 (read-string "Action: ") "\""
659 ))
661 (defun yahtml:select ()
662 "Add-in function for `select' input format"
663 (setq yahtml-last-single-cmd "option")
664 (concat " " (if yahtml-prefer-upcases "NAME" "name") "=\""
665 (read-string "name: ") "\""))
667 (defun yahtml:ol ()
668 (setq yahtml-last-single-cmd "li") "")
669 (defun yahtml:ul ()
670 (setq yahtml-last-single-cmd "li") "")
671 (defun yahtml:dl ()
672 (setq yahtml-last-single-cmd "dt") "")
673 (defun yahtml:dt ()
674 (setq yahtml-last-single-cmd "dd") "")
676 (defun yahtml:p ()
677 (let ((alg (yahtml-read-parameter "align")))
678 (if (string< "" alg)
679 (setq alg (concat "align=" alg)
680 alg (if yahtml-prefer-upcases (upcase alg) (downcase alg)))
681 "")))
683 (defvar yahtml-input-types
684 '(("text") ("password") ("checkbox") ("radio") ("submit")
685 ("reset") ("image") ("hidden") ("file")))
687 (defun yahtml:input ()
688 "Add-in function for `input' form"
689 (let ((size "") name type value checked (maxlength "")
690 (l yahtml-prefer-upcases))
691 (setq name (read-string "name: ")
692 type (completing-read "type (default=text): "
693 yahtml-input-types nil t)
694 value (read-string "value: "))
695 (if (string-match "text\\|password\\|^$" type)
696 (setq size (read-string "size: ")
697 maxlength (read-string "maxlength: ")))
698 (concat
699 (if l "NAME" "name") "=\"" name "\""
700 (if (string< "" type)
701 (concat " " (if l "TYPE" "type") "=\"" type "\""))
702 (if (string< "" value)
703 (concat " " (if l "VALUE" "value") "=\"" value "\""))
704 (if (string< "" size)
705 (concat " " (if l "SIZE" "size") "=\"" size "\""))
706 (if (string< "" maxlength)
707 (concat " " (if l "MAXLENGTH" "maxlength") "=\"" maxlength "\""))
708 )))
710 (defun yahtml:textarea ()
711 "Add-in function for `textarea'"
712 (interactive)
713 (let (name rows cols)
714 (setq name (read-string "Name: ")
715 cols (read-string "Columns: ")
716 rows (read-string "Rows: "))
717 (concat
718 (concat (if yahtml-prefer-upcases "NAME=" "name=")
719 "\"" name "\"")
720 (if (string< "" cols)
721 (concat " " (if yahtml-prefer-upcases "COLS" "cols") "=" cols))
722 (if (string< "" rows)
723 (concat " " (if yahtml-prefer-upcases "ROWS" "rows") "=" rows)))))
726 ;;; ---------- Simple tag ----------
727 (defun yahtml-insert-tag (region-mode &optional tag)
728 "Insert <TAG> </TAG> and put cursor inside of them."
729 (interactive "P")
730 (or tag
731 (let ((completion-ignore-case t))
732 (setq tag
733 (YaTeX-cplread-with-learning
734 (format "Tag %s(default %s): "
735 (if region-mode "region: " "") yahtml-last-typeface-cmd)
736 'yahtml-typeface-table 'yahtml-user-typeface-table
737 'yahtml-tmp-typeface-table))))
738 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))
739 (setq tag (or (cdr (assoc tag yahtml-typeface-table)) tag))
740 (setq yahtml-last-typeface-cmd tag
741 tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag))
742 (if region-mode
743 (if (if (string< "19" emacs-version) (mark t) (mark))
744 (save-excursion
745 (if (> (point) (mark)) (exchange-point-and-mark))
746 (insert (format "<%s%s>" tag (yahtml-addin tag)))
747 (exchange-point-and-mark)
748 (insert "</" tag ">"))
749 (message "No mark set now"))
750 (insert (format "<%s%s>" tag (yahtml-addin tag)))
751 (save-excursion (insert (format "</%s>" tag)))))
753 (defun yahtml-insert-tag-region (&optional tag)
754 "Call yahtml-insert-tag with region mode."
755 (interactive)
756 (yahtml-insert-tag t tag))
758 (defun yahtml-insert-single (cmd)
759 "Insert <CMD>."
760 (interactive
761 (list
762 (let ((completion-ignore-case t))
763 (YaTeX-cplread-with-learning
764 (format "Command%s: "
765 (if yahtml-last-single-cmd
766 (concat "(default " yahtml-last-single-cmd ")") ""))
767 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table
768 'yahtml-tmp-single-cmd-table))))
769 (if (string= "" cmd) (setq cmd yahtml-last-single-cmd))
770 (setq yahtml-last-single-cmd
771 (or (cdr (assoc cmd yahtml-single-cmd-table)) cmd))
772 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
773 yahtml-last-single-cmd))
774 (insert (format "<%s>" cmd)))
776 ;;; ---------- Jump ----------
777 (defun yahtml-on-href-p ()
778 "Check if point is on href clause."
779 (let ((p (point)) e cmd (case-fold-search t))
780 (save-excursion
781 (and (string= (YaTeX-inner-environment t) "a")
782 (save-excursion
783 (search-forward "</a>" nil t)
784 (setq e (point)))
785 (goto-char (get 'YaTeX-inner-environment 'point))
786 (search-forward "href" e t)
787 (search-forward "=" e t)
788 (skip-chars-forward " \t\n")
789 (looking-at "\"?\\([^\"> \t\n]+\\)\"?")
790 (< p (match-end 0))
791 (YaTeX-match-string 1)
792 ))))
794 (defun yahtml-netscape-sentinel (proc mes)
795 (cond
796 ((null (buffer-name (process-buffer proc)))
797 (set-process-buffer proc nil))
798 ((eq (process-status proc) 'exit)
799 (let ((cb (current-buffer)))
800 (set-buffer (process-buffer proc))
801 (goto-char (point-min))
802 (if (search-forward "not running" nil t)
803 (progn
804 (message "Starting netscape...")
805 (start-process
806 "browser" (process-buffer proc)
807 shell-file-name yahtml-shell-command-option
808 (format "%s \"%s\"" yahtml-www-browser
809 (get 'yahtml-netscape-sentinel 'url)))
810 (message "Starting netscape...Done")))
811 (set-buffer cb)))))
813 (defvar yahtml-browser-process nil)
815 (defun yahtml-browse-html (href)
816 "Call WWW Browser to see HREF."
817 (let ((pb "* WWW Browser *") (cb (current-buffer)))
818 (cond
819 ((and (string-match "[Nn]etscape" yahtml-www-browser)
820 (not (eq system-type 'windows-nt)))
821 (if (get-buffer pb)
822 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
823 (put 'yahtml-netscape-sentinel 'url href)
824 (set-process-sentinel
825 (setq yahtml-browser-process
826 (start-process
827 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
828 (format "%s -remote \"openURL(%s)\"" yahtml-www-browser href)))
829 'yahtml-netscape-sentinel))
830 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))
831 (w3-fetch href))
832 ((stringp yahtml-www-browser)
833 (if (and yahtml-browser-process
834 (eq (process-status yahtml-browser-process) 'run))
835 (message "%s is already running" yahtml-www-browser)
836 (setq yahtml-browser-process
837 (start-process
838 "browser" "* WWW Browser *"
839 shell-file-name yahtml-shell-command-option
840 (format "%s \"%s\"" yahtml-www-browser href)))))
841 (t
842 (message "Sorry, jump across http is not supported.")))))
844 (defun yahtml-goto-corresponding-href (&optional other)
845 "Go to corresponding name."
846 (let ((href (yahtml-on-href-p)) file name)
847 (if href
848 (cond
849 ((string-match "^\\(ht\\|f\\)tp:" href)
850 (yahtml-browse-html href))
851 (t (setq file (substring href 0 (string-match "#" href)))
852 (if (string-match "#" href)
853 (setq name (substring href (1+ (string-match "#" href)))))
854 (if (string< "" file)
855 (progn
856 (if (string-match "/$" file)
857 (setq file (concat file yahtml-directory-index)))
858 (if (string-match "^/" file)
859 (setq file (yahtml-url-to-path file)))
860 (if other (YaTeX-switch-to-buffer-other-window file)
861 (YaTeX-switch-to-buffer file))))
862 (if name
863 (progn (set-mark-command nil) (yahtml-jump-to-name name)))
864 t)))))
866 (defun yahtml-jump-to-name (name)
867 "Jump to html's named tag."
868 (setq name (format "name\\s *=\\s *\"?%s\"?" name))
869 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))
870 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))
871 (message "Named tag `%s' not found" (substring href 1))))
873 (defun yahtml-on-begend-p (&optional p)
874 "Check if point is on begend clause."
875 (let ((p (or p (point))) cmd (case-fold-search t))
876 (save-excursion
877 (goto-char p)
878 (if (equal (char-after (point)) ?<) (forward-char 1))
879 (if (and (re-search-backward "<" nil t)
880 (looking-at
881 (concat "<\\(/?" yahtml-struct-name-regexp "\\)\\b"))
882 (condition-case nil
883 (forward-list 1)
884 (error nil))
885 (< p (point)))
886 (YaTeX-match-string 1)))))
888 (defun yahtml-goto-corresponding-begend (&optional noerr)
889 "Go to corresponding opening/closing tag.
890 Optional argument NOERR causes no error for unballanced tag."
891 (let ((cmd (yahtml-on-begend-p)) m0
892 (p (point)) (case-fold-search t) func str (nest 0))
893 (cond
894 (cmd
895 (setq m0 (match-beginning 0))
896 (if (= (aref cmd 0) ?/) ;on </cmd> line
897 (setq cmd (substring cmd 1)
898 str (format "\\(<%s\\)\\|\\(</%s\\)" cmd cmd)
899 func 're-search-backward)
900 (setq str (format "\\(</%s\\)\\|\\(<%s\\)" cmd cmd)
901 func 're-search-forward))
902 (while (and (>= nest 0) (funcall func str nil t))
903 (if (equal m0 (match-beginning 0))
904 nil
905 (setq nest (+ nest (if (match-beginning 1) -1 1)))))
906 (if (< nest 0)
907 (goto-char (match-beginning 0))
908 (funcall
909 (if noerr 'message 'error)
910 "Corresponding tag of `%s' not found." cmd)
911 (goto-char p)
912 nil))
913 (t nil))))
915 (defun yahtml-current-tag ()
916 "Return the current tag name."
917 (save-excursion
918 (let ((p (point)) b tag)
919 (or (bobp)
920 (looking-at "<")
921 (progn (skip-chars-backward "^<") (forward-char -1)))
922 (setq b (point))
923 (skip-chars-forward "<")
924 (setq tag (buffer-substring
925 (point) (progn (skip-chars-forward "^ \t\n") (point))))
926 (goto-char b)
927 (forward-list 1)
928 (and (< p (point)) tag))))
931 (defun yahtml-goto-corresponding-img ()
932 "View image on point"
933 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))
934 (if (and tag
935 (string-match "img" tag)
936 (save-excursion
937 (re-search-backward "<\\s *img" nil t)
938 (re-search-forward "src=\"?\\([^\"> ]+\\)\"?")
939 (match-beginning 1)
940 (setq image
941 (buffer-substring (match-beginning 1) (match-end 1)))))
942 (progn
943 (message "Invoking %s %s..." yahtml-image-viewer image)
944 (start-process
945 "Viewer" " * Image Viewer *"
946 shell-file-name yahtml-shell-command-option ;"-c"
947 (concat yahtml-image-viewer " " image))
948 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))
950 (defun yahtml-goto-corresponding-* (&optional other)
951 "Go to corresponding object."
952 (interactive)
953 (cond
954 ((yahtml-goto-corresponding-href other))
955 ((yahtml-goto-corresponding-img))
956 ((yahtml-goto-corresponding-begend))
957 ))
959 (defun yahtml-goto-corresponding-*-other-window ()
960 "Go to corresponding object."
961 (interactive)
962 (yahtml-goto-corresponding-* t))
964 ;;; ---------- killing ----------
965 (defun yahtml-kill-begend (&optional whole)
966 (let ((tag (yahtml-on-begend-p)) (p (make-marker)) (q (make-marker)))
967 (if tag
968 (progn
969 (or (looking-at "<")
970 (progn (skip-chars-backward "^<") (forward-char -1)))
971 (set-marker p (point))
972 (yahtml-goto-corresponding-begend)
973 (or (looking-at "<")
974 (progn (skip-chars-backward "^<") (forward-char -1)))
975 (delete-region (point) (progn (forward-list 1) (point)))
976 (set-marker q (point))
977 (beginning-of-line)
978 (if (looking-at "^\\s *$")
979 (delete-region (point) (progn (forward-line 1) (point))))
980 (goto-char p)
981 (delete-region (point) (progn (forward-list 1) (point)))
982 (if (looking-at "^\\s *$")
983 (delete-region (point) (progn (forward-line 1) (point))))
984 (if whole (delete-region p q))
985 tag))))
987 (defun yahtml-kill-* (whole)
988 "Kill current position's HTML tag (set)."
989 (interactive "P")
990 (cond
991 ((yahtml-kill-begend whole))
992 ))
995 ;;; ---------- changing ----------
996 (defun yahtml-on-assignment-p ()
997 "Return if current point is on parameter assignment.
998 If so, return parameter name, otherwise nil.
999 This function should be able to treat white spaces in value, but not yet."
1000 (let ((p (point)))
1001 (save-excursion
1002 (put 'yahtml-on-assignment-p 'region nil)
1003 (skip-chars-backward "^ \t")
1004 (and (looking-at "\\([A-Za-z0-9]+\\)\\s *=\\s *\"?\\([^ \t\"]+\\)\"?")
1005 (< p (match-end 0))
1006 (>= p (1- (match-beginning 2)))
1007 (put 'yahtml-on-assignment-p 'region
1008 (cons (match-beginning 2) (match-end 2)))
1009 (YaTeX-match-string 1)))))
1011 (defun yahtml-change-begend ()
1012 (let ((tag (yahtml-on-begend-p))
1013 (completion-ignore-case t)
1014 (case-fold-search t)
1015 (p (point)) (q (make-marker))
1016 (default (append yahtml-env-table yahtml-typeface-table))
1017 (user (append yahtml-user-env-table yahtml-user-typeface-table))
1018 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))
1019 href b1 e1)
1020 (cond
1021 (tag
1022 (cond
1023 ((and (string-match "^a$" tag)
1024 (save-excursion
1025 (and
1026 (re-search-backward "<a\\b" nil t)
1027 (goto-char (match-end 0))
1028 (skip-chars-forward " \t\n")
1029 (setq b1 (point))
1030 (search-forward ">" nil t)
1031 (setq e1 (match-beginning 0))
1032 (goto-char b1)
1033 (re-search-forward "href\\s *=" e1 t)
1034 (>= p (point))
1035 (goto-char (match-end 0))
1036 (skip-chars-forward " \t\n")
1037 (looking-at "\"?\\([^\"> \t\n]+\\)\"?")
1038 (< p (match-end 0)))))
1039 (setq b1 (match-beginning 1) e1 (match-end 1)
1040 yahtml-completing-buffer (current-buffer)
1041 href (read-from-minibuffer
1042 "Change href to: " "" yahtml-url-completion-map))
1043 (if (string< "" href)
1044 (progn
1045 ;;(setq href ;??
1046 ;; (if yahtml-prefer-upcases (upcase href) (downcase href)))
1047 (delete-region b1 e1)
1048 (goto-char b1)
1049 (insert href))))
1050 (t
1051 (save-excursion
1052 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))
1053 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))
1054 (skip-chars-forward "^A-Za-z")
1055 (set-marker q (point))
1056 (setq p (point))
1057 (yahtml-goto-corresponding-begend)
1058 (or (= (char-after (point)) ?<)
1059 (skip-chars-backward "^<"))
1060 (skip-chars-forward "^A-Za-z")
1061 (if (= (char-after (1- (point))) ?/)
1062 (progn
1063 (set-marker q (point))
1064 (goto-char p)))
1065 (setq tag (let ((completion-ignore-case t))
1066 (YaTeX-cplread-with-learning
1067 (format "Change `%s' to(default %s): "
1068 tag yahtml-last-begend)
1069 'default 'user 'tmp)))
1070 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
1071 (if (string= "" tag) (setq tag yahtml-last-begend))
1072 (setq yahtml-last-begend
1073 (or (cdr (assoc tag yahtml-env-table)) tag)
1074 tag yahtml-last-begend)
1075 (setq tag (if yahtml-prefer-upcases (upcase tag) (downcase tag)))
1076 (insert (format "%s%s" tag (yahtml-addin tag)))
1077 (goto-char q)
1078 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
1079 (insert tag))))
1080 t))))
1082 (defun yahtml-change-command ()
1083 (let ((p (point)) (case-fold-search t) cmd par new
1084 (beg (make-marker)) (end (make-marker)))
1085 (skip-chars-backward "^<")
1086 (if (and
1087 (looking-at yahtml-command-regexp)
1088 (progn
1089 (set-marker beg (match-beginning 0))
1090 (set-marker end (match-end 0))
1091 t) ;for further work
1092 (progn
1093 (forward-char -1)
1094 (condition-case nil
1095 (forward-list 1)
1096 (error nil))
1097 (< p (point))))
1098 (progn
1099 (goto-char p)
1100 (if (setq par (yahtml-on-assignment-p))
1101 (progn
1102 (setq new (yahtml-read-parameter par))
1103 (set-marker beg (car (get 'yahtml-on-assignment-p 'region)))
1104 (set-marker end (cdr (get 'yahtml-on-assignment-p 'region))))
1105 (setq new
1106 (YaTeX-cplread-with-learning
1107 "Change form to: "
1108 'yahtml-form-table 'yahtml-user-form-table
1109 'yahtml-tmp-form-table)))
1110 (delete-region beg end)
1111 (goto-char beg)
1112 (insert new)
1113 t)
1114 (goto-char p)
1115 nil)))
1117 (defun yahtml-change-* ()
1118 "Change current position's HTML tag (set)."
1119 (interactive)
1120 (cond
1121 ((yahtml-change-begend))
1122 ((yahtml-change-command))
1123 ))
1125 ;;; ---------- commenting ----------
1126 (defun yahtml-comment-region (beg end)
1127 (interactive "r")
1128 (comment-region beg end nil))
1130 (defun yahtml-uncomment-region (beg end)
1131 (interactive "r")
1132 (comment-region beg end '(4)))
1136 (defun yahtml-inner-environment-but (exclude &optional quick)
1137 "Return the inner environment but matches with EXCLUDE tag."
1138 (let (e)
1139 (save-excursion
1140 (while (and (setq e (YaTeX-inner-environment quick))
1141 (string-match exclude e))
1142 (goto-char (get 'YaTeX-inner-environment 'point))))
1143 e))
1145 ;;; ---------- filling ----------
1147 (defvar yahtml-saved-move-to-column (symbol-function 'move-to-column))
1148 (defun yahtml-move-to-column (col &optional force)
1149 (beginning-of-line)
1150 (let ((ccol 0))
1151 (while (and (> col ccol) (not (eolp)))
1152 (if (eq (following-char) ?\<)
1153 (progn
1154 (while (and (not (eq (following-char) ?\>))
1155 (not (eolp)))
1156 (forward-char))
1157 (or (eolp) (forward-char)))
1158 (or (eolp) (forward-char))
1159 (if (eq (preceding-char) ?\t)
1160 (let ((wd (- 8 (% (+ ccol 8) 8))))
1161 (if (and force (< col (+ ccol wd)))
1162 (progn
1163 (backward-char 1)
1164 (insert-char ?\ (- col ccol))
1165 (setq ccol col))
1166 (setq ccol (+ ccol wd))))
1167 (setq ccol (1+ ccol)))
1168 (if (and YaTeX-japan
1169 (string-match "[chj]" (char-category (preceding-char))))
1170 (setq ccol (1+ ccol)))))
1171 (if (and force (> col ccol))
1172 (progn
1173 (insert-char ?\ (- col ccol))
1174 col)
1175 ccol)))
1177 (defun yahtml-fill-paragraph (arg)
1178 (interactive "P")
1179 (let*((case-fold-search t) (p (point))
1180 (e (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t) "html"))
1181 (prep (string-match "^pre$" e))
1182 (ps1 (if prep (default-value 'paragraph-start)
1183 paragraph-start))
1184 (ps2 (if prep (concat (default-value 'paragraph-start)
1185 "\\|^\\s *</?pre>")
1186 paragraph-start)))
1187 (save-excursion
1188 (unwind-protect
1189 (progn
1190 (if prep
1191 (fset 'move-to-column 'yahtml-move-to-column))
1192 (fill-region-as-paragraph
1193 (progn (re-search-backward paragraph-start nil t)
1194 (or (save-excursion
1195 (goto-char (match-end 0))
1196 (skip-chars-forward " \t>")
1197 (if (looking-at "[ \t]*$")
1198 (progn (forward-line 1) (point))))
1199 (point)))
1200 (progn (goto-char p)
1201 (re-search-forward ps2 nil t)
1202 (match-beginning 0))))
1203 (fset 'move-to-column yahtml-saved-move-to-column)))))
1205 ;(defun yahtml-indent-new-commnet-line ()
1206 ; (unwind-protect
1207 ; (progn
1208 ; (fset 'move-to-column 'yahtml-move-to-column)
1209 ; (apply 'YaTeX-saved-indent-new-comment-line (if soft (list soft))))
1210 ; (fset 'move-to-column yahtml-saved-move-to-column)))
1212 ;;;
1213 ;;; ---------- indentation ----------
1214 ;;;
1215 (defun yahtml-indent-line ()
1216 (interactive)
1217 (let ((envs "[uod]l\\|table\\|t[rhd]\\|select\\|blockquote")
1218 (itms "<\\(dt\\|dd\\|li\\|t[rdh]\\|option\\)\\b")
1219 inenv p col peol (case-fold-search t))
1220 (save-excursion
1221 (beginning-of-line)
1222 (setq inenv (or (yahtml-inner-environment-but "^\\(a\\|p\\)\\b" t)
1223 "html")
1224 col (get 'YaTeX-inner-environment 'indent)
1225 p (get 'YaTeX-inner-environment 'point)
1226 op))
1227 (save-excursion
1228 (cond
1229 ((string-match envs inenv)
1230 (save-excursion
1231 (beginning-of-line)
1232 (skip-chars-forward " \t")
1233 (cond
1234 ((looking-at (concat "</\\(" envs "\\)>"))
1235 (YaTeX-reindent col))
1236 ((or (looking-at itms)
1237 (and yahtml-hate-too-deep-indentation
1238 (looking-at (concat "<" envs))))
1239 (YaTeX-reindent (+ col yahtml-environment-indent)))
1240 ((and (< p (point))
1241 (save-excursion
1242 (and
1243 ;;(re-search-backward itms p t)
1244 (setq op (point))
1245 (goto-char p)
1246 (re-search-forward itms op t)
1247 ;(goto-char (match-end 0))
1248 (skip-chars-forward "^>")
1249 (skip-chars-forward ">")
1250 (skip-chars-forward " \t")
1251 (setq col (current-column)))))
1252 (YaTeX-reindent col))
1253 (t
1254 (YaTeX-reindent (+ col yahtml-environment-indent)))))))
1255 (and (bolp) (skip-chars-forward " \t"))
1256 (if (and (setq inenv (yahtml-on-begend-p))
1257 (string-match (concat "^\\(" envs "\\)") inenv))
1258 (save-excursion
1259 (setq peol (point-end-of-line))
1260 (or (= (char-after (point)) ?<)
1261 (progn (skip-chars-backward "^<") (forward-char -1)))
1262 (setq col (current-column))
1263 (if (and (yahtml-goto-corresponding-begend t)
1264 (> (point) peol)) ;if on the different line
1265 (YaTeX-reindent col)))))
1266 (and (bolp) (skip-chars-forward " \t"))))
1268 ;(defun yahtml-fill-item ()
1269 ; "Fill item HTML version"
1270 ; (interactive)
1271 ; (let (inenv p fill-prefix peol (case-fold-search t))
1272 ; (setq inenv (or (YaTeX-inner-environment) "html")
1273 ; p (get 'YaTeX-inner-environment 'point))
1274 ; (cond
1275 ; ((string-match "^[uod]l" inenv)
1276 ; (save-excursion
1277 ; (if (re-search-backward "<\\(d[td]\\|li\\)>[ \t\n]*" p t)
1278 ; (progn
1279 ; (goto-char (match-end 0))
1280 ; (setq col (current-column)))
1281 ; (error "No <li>, <dt>, <dd>")))
1282 ; (save-excursion
1283 ; (end-of-line)
1284 ; (setq peol (point))
1285 ; (newline)
1286 ; (indent-to-column col)
1287 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))
1288 ; (delete-region (point) peol)
1289 ; (fill-region-as-paragraph
1290 ; (progn (re-search-backward paragraph-start nil t) (point))
1291 ; (progn (re-search-forward paragraph-start nil t 2)
1292 ; (match-beginning 0)))))
1293 ; (t nil))))
1295 ;;;
1296 ;;; ---------- Lint and Browsing ----------
1297 ;;;
1298 (defun yahtml-browse-menu ()
1299 "Browsing menu"
1300 (interactive)
1301 (message "J)weblint p)Browse R)eload...")
1302 (let ((c (char-to-string (read-char))))
1303 (cond
1304 ((string-match "j" c)
1305 (yahtml-lint-buffer (current-buffer)))
1306 ((string-match "[bp]" c)
1307 (yahtml-browse-current-file))
1308 ((string-match "r" c)
1309 (yahtml-browse-reload)))))
1311 (defvar yahtml-lint-buffer "*weblint*")
1313 (defun yahtml-lint-buffer (buf)
1314 "Call lint on buffer BUF."
1315 (interactive "bCall lint on buffer: ")
1316 (setq buf (get-buffer buf))
1317 (YaTeX-save-buffers)
1318 (YaTeX-typeset
1319 (concat yahtml-lint-program " "
1320 (file-name-nondirectory (buffer-file-name buf)))
1321 yahtml-lint-buffer "lint" "lint"))
1323 (defun yahtml-file-to-url (file)
1324 "Convert local unix file name to URL.
1325 If no matches found in yahtml-path-url-alist, return raw file name."
1326 (let ((list yahtml-path-url-alist) p url)
1327 (if (file-directory-p file)
1328 (setq file (expand-file-name yahtml-directory-index file))
1329 (setq file (expand-file-name file)))
1330 (if (string-match "^[A-Za-z]:/" file)
1331 (progn
1332 ;; (aset file 1 ?|) ;これは要らないらしい…
1333 (setq file (concat "///" file))))
1334 (while list
1335 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)
1336 (setq url (cdr (car list))
1337 file (substring file (match-end 0))
1338 url (concat url file)
1339 list nil))
1340 (setq list (cdr list)))
1341 (or url (concat "file:" file))))
1343 (defun yahtml-url-to-path (file &optional basedir)
1344 "Convert local URL name to unix file name."
1345 (let ((list yahtml-path-url-alist) url realpath docroot
1346 (dirsufp (string-match "/$" file)))
1347 (setq basedir (or basedir
1348 (file-name-directory
1349 (expand-file-name default-directory))))
1350 (cond
1351 ((string-match "^/" file)
1352 (while list
1353 (if (file-directory-p (car (car list)))
1354 (progn
1355 (setq url (cdr (car list)))
1356 (if (string-match "\\(http://[^/]*\\)/" url)
1357 (setq docroot (substring url (match-end 1)))
1358 (setq docroot url))
1359 (if (string-match (concat "^" (regexp-quote docroot)) file)
1360 (setq realpath
1361 (expand-file-name
1362 (substring
1363 file
1364 (if (= (aref file (1- (match-end 0))) ?/)
1365 (match-end 0) ; "/foo"
1366 (min (1+ (match-end 0)) (length file)))) ; "/~foo"
1367 (car (car list)))))
1368 (if realpath
1369 (progn (setq list nil)
1370 (if (and dirsufp (not (string-match "/$" realpath)))
1371 (setq realpath (concat realpath "/")))))))
1372 (setq list (cdr list)))
1373 realpath)
1374 (t file))))
1376 (defun yahtml-browse-current-file ()
1377 "Call WWW browser on current file."
1378 (interactive)
1379 (basic-save-buffer)
1380 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))
1382 (defun yahtml-browse-reload ()
1383 "Send `reload' event to netzscape."
1384 (let ((pb "* WWW Browser *") (cb (current-buffer)))
1385 (cond
1386 ((string-match "[Nn]etscape" yahtml-www-browser)
1387 (if (get-buffer pb)
1388 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1389 ;;(or (get 'yahtml-netscape-sentinel 'url)
1390 ;; (error "Reload should be called after Browsing."))
1391 (put 'yahtml-netscape-sentinel 'url
1392 (yahtml-file-to-url (buffer-file-name)))
1393 (basic-save-buffer)
1394 (set-process-sentinel
1395 (setq yahtml-browser-process
1396 (start-process
1397 "browser" pb shell-file-name yahtml-shell-command-option ;"-c"
1398 (format "%s -remote 'reload'" yahtml-www-browser)))
1399 'yahtml-netscape-sentinel))
1400 (t
1401 (message "Sorry, RELOAD is supported only for Netscape.")))))
1403 ;;; ---------- Intelligent newline ----------
1404 (defun yahtml-intelligent-newline (arg)
1405 "Intelligent newline for HTML"
1406 (interactive "P")
1407 (let (env func)
1408 (end-of-line)
1409 (setq env (downcase (or (YaTeX-inner-environment) "html")))
1410 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))
1411 (newline)
1412 (if (and env func (fboundp func))
1413 (funcall func))))
1415 (defun yahtml-intelligent-newline-ul ()
1416 (interactive)
1417 (insert (if yahtml-prefer-upcases "<LI> " "<li> "))
1418 (yahtml-indent-line))
1420 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)
1422 (defun yahtml-intelligent-newline-dl ()
1423 (interactive)
1424 (let ((case-fold-search t))
1425 (if (save-excursion
1426 (re-search-backward "<\\(\\(dt\\)\\|\\(dd\\)\\)>"
1427 (get 'YaTeX-inner-environment 'point) t))
1428 (cond
1429 ((match-beginning 2)
1430 (insert (if yahtml-prefer-upcases "<DD> " "<dd> "))
1431 (setq yahtml-last-single-cmd "dt"))
1432 ((match-beginning 3)
1433 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))
1434 (setq yahtml-last-single-cmd "dd")))
1435 (insert (if yahtml-prefer-upcases "<DT> " "<dt> ")))
1436 (yahtml-indent-line)))
1438 (defun yahtml-intelligent-newline-select ()
1439 (interactive)
1440 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")
1441 (yahtml-indent-line))
1443 ;;; ---------- Marking ----------
1444 (defun yahtml-mark-begend ()
1445 "Mark current tag"
1446 (interactive)
1447 (YaTeX-beginning-of-environment)
1448 (let ((p (point)))
1449 (save-excursion
1450 (skip-chars-backward " \t" (point-beginning-of-line))
1451 (if (bolp) (setq p (point))))
1452 (push-mark p t))
1453 (yahtml-goto-corresponding-begend)
1454 (forward-list 1)
1455 (if (eolp) (forward-char 1)))
1457 ;;; ---------- complete marks ----------
1458 (defun yahtml-complete-mark ()
1459 "Complete >, <, &ersand, and "e."
1460 (interactive)
1461 (message "1:< 2:> 3:& 4:\"")
1462 (let ((c (read-char)))
1463 (setq c (if (or (< c ?0) (> c ?5))
1464 (string-match (regexp-quote (char-to-string c)) "<>&\"")
1465 (- c ?1)))
1466 (if (or (< c 0) (> c 4))
1467 nil
1468 (insert (format "&%s;" (nth c '("lt" "gt" "amp" "quot")))))))
1471 ;;; ---------- jump to error line ----------
1472 (defvar yahtml-error-line-regexp
1473 "^\\(.*\\)(\\([0-9]+\\)):"
1474 "*Regexp of error position which is produced by lint program.")
1475 (defun yahtml-prev-error ()
1476 "Jump to previous error seeing lint buffer."
1477 (interactive)
1478 (or (get-buffer yahtml-lint-buffer)
1479 (error "No lint program ran."))
1480 (YaTeX-showup-buffer yahtml-lint-buffer nil t)
1481 (yahtml-jump-to-error-line))
1483 (defun yahtml-jump-to-error-line ()
1484 (interactive)
1485 (let ((p (point)) (e (point-end-of-line)))
1486 (end-of-line)
1487 (if (re-search-backward yahtml-error-line-regexp nil t)
1488 (let ((f (YaTeX-match-string 1))
1489 (l (string-to-int (YaTeX-match-string 2))))
1490 (forward-line -1)
1491 (YaTeX-showup-buffer f nil t)
1492 (goto-line l))
1493 (message "No line number usage"))))
1495 ;;; ---------- ----------
1497 ;;;
1498 ;;hilit19
1499 ;;;
1500 (defvar yahtml-default-face-table
1501 '(
1502 (form black/ivory white/hex-442233 italic)
1503 ))
1504 (defvar yahtml-hilit-patterns-alist
1505 '(
1506 ;; comments
1507 ("<!--\\s " "-->" comment)
1508 ;; include&exec
1509 ("<!--#\\(include\\|exec\\)" "-->" include)
1510 ;; string
1511 (hilit-string-find 39 string)
1512 (yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
1513 ("</?[uod]l>" 0 decl)
1514 ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
1515 ("<a\\s +href" "</a>" crossref)
1516 ("</?\\sw+>" 0 decl)
1517 ("<form" "</form" form)
1518 ))
1520 (defun yahtml-hilit-region-tag (tag)
1521 "Return list of start/end point of <TAG> form."
1522 (if (re-search-forward (concat "<" tag ">") nil t)
1523 (let ((m0 (match-beginning 0)))
1524 (skip-chars-forward " \t\n")
1525 (cons (point)
1526 (progn (re-search-forward (concat "</" tag ">") nil t)
1527 (match-beginning 0))))))
1529 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))
1530 (cond
1531 ((and (featurep 'hilit19) (featurep 'yatex19))
1532 (or (assq 'yahtml-mode hilit-patterns-alist)
1533 (setq hilit-patterns-alist
1534 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
1535 hilit-patterns-alist)))))
1537 (provide 'yahtml)
1539 ; Local variables:
1540 ; fill-prefix: ";;; "
1541 ; paragraph-start: "^$\\| \\|;;;$"
1542 ; paragraph-separate: "^$\\| \\|;;;$"
1543 ; End: