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