yatex
view yahtml.el @ 59:48ac97a6b6ce
Call drawing tools
ID completion (yahtml)
| author | yuuji |
|---|---|
| date | Wed, 01 May 1996 15:35:40 +0000 |
| parents | 3a7c0c2bf16d |
| children | 9e08ed569d80 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; (c ) 1994 by HIROSE Yuuji [yuuji@ae.keio.ac.jp, pcs39334@asciinet.or.jp]
3 ;;; Last modified Tue Apr 23 23:13:12 1996 on inspire
4 ;;; This package is no longer tentative.
5 ;;; $Id$
7 ;;;[Installation]
8 ;;;
9 ;;; First, you have to install YaTeX and make sure it works fine. Then
10 ;;; put these expressions into your ~/.emacs
11 ;;;
12 ;;; (setq auto-mode-alist
13 ;;; (cons (cons "\\.html$" 'yahtml-mode) auto-mode-alist))
14 ;;; (autoload 'yahtml-mode "yahtml" "Yet Another HTML mode" t)
15 ;;; (setq yahtml-www-browser "netscape")
16 ;;; ;Write your favorite browser. But netscape is advantageous.
17 ;;; (setq yahtml-path-url-alist
18 ;;; '(("/home/yuuji/public_html" . "http://www.mynet/~yuuji")
19 ;;; ("/home/staff/yuuji/html" . "http://www.othernet/~yuuji")))
20 ;;; ;Write correspondence alist from ABSOLUTE unix path name to URL path.
21 ;;;
22 ;;;[Commentary]
23 ;;;
24 ;;; It is assumed you are already familiar with YaTeX. The following
25 ;;; completing featureas are available: ([prefix] means `C-c' by default)
26 ;;;
27 ;;; * [prefix] b X Complete environments such as `H1' which
28 ;;; normally requires closing tag `</H1>
29 ;;; <a href=foo> ... </a> is also classified into
30 ;;; this group
31 ;;; When input `href=...', you can complete file
32 ;;; name or label(href="#foo") by typing TAB.
33 ;;; * [prefix] s Complete declarative notations such as
34 ;;; `<img src="foo.gif">'
35 ;;; `<input name="var" ...>'
36 ;;; * [prefix] l Complete typeface-changing commands such as
37 ;;; `<i> ... </i>' or `<samp> ... </samp>'
38 ;;; * [prefix] m Complete single commands such as
39 ;;; `<br>' or `<hr> or <li>...'
40 ;;; * M-RET Intelligent newline; if current TAG is one of
41 ;;; ul, ol, or dl. insert newline and <li> or
42 ;;; <dt> or <dd> suitable for current condition.
43 ;;; * menu-bar yahtml Complete all by selecting a menu item (Though I
44 ;;; hate menu, this is most useful)
45 ;;; * [prefix] g Goto corresponding Tag or HREF such as
46 ;;; <dl> <-> </dl> or href="xxx".
47 ;;; Or invoke image viewer if point is on <img src=...>.
48 ;;; * [prefix] k Kill html tags on the point. If you provide
49 ;;; universal-argument, kill surrounded contents too.
50 ;;; * [prefix] c Change html tags on the point.
51 ;;; When typeing [prefix] c on `href="xxx"', you can
52 ;;; change the reference link with completion.
53 ;;; * [prefix] t b View current html with WWW browser
54 ;;; (To activate this, never fail to set the lisp
55 ;;; variable yahtml-www-browser. Recommended value
56 ;;; is "netscape")
57 ;;; * [prefix] a YaTeX's accent mark's equivalent of yahtml.
58 ;;; This function can input $lt, $gt or so.
59 ;;;
62 (require 'yatex)
63 (defvar yahtml-prefix-map nil)
64 (defvar yahtml-mode-map nil "Keymap used in yahtml-mode.")
65 (defvar yahtml-image-viewer "xv" "*Image viewer program")
66 (defvar yahtml-www-browser "netscape"
67 "*WWW Browser command")
68 (defvar yahtml-kanji-code 2
69 "Kanji coding system of html file; 1=sjis, 2=jis, 3=euc")
70 ;;(defvar yahtml-www-server "www" "*Host name of your domain's WWW server")
71 (defvar yahtml-path-url-alist nil
72 "*Alist of unix path name vs. URL name of WWW server.
73 Ex.
74 '((\"/usr/home/yuuji/http\" . \"http://www.comp.ae.keio.ac.jp/~yuuji\")
75 (\"/usr/home/yuuji/darts/http\" . \"http://inspire.comp.ae.keio.ac.jp/~darts\"))")
76 (defvar yahtml-directory-index "index.html"
77 "*Directory index file name;
78 Consult your site's WWW administrator.")
80 (defun yahtml-define-begend-key-normal (key env &optional map)
81 "Define short cut yahtml-insert-begin-end key."
82 (YaTeX-define-key
83 key
84 (list 'lambda '(arg) '(interactive "P")
85 (list 'yahtml-insert-begin-end env 'arg))
86 map))
88 (defun yahtml-define-begend-region-key (key env &optional map)
89 "Define short cut yahtml-insert-begin-end-region key."
90 (YaTeX-define-key key (list 'lambda nil '(interactive)
91 (list 'yahtml-insert-begin-end env t)) map))
93 (defun yahtml-define-begend-key (key env &optional map)
94 "Define short cut key for begin type completion both for
95 normal and region mode. To customize yahtml, user should use this function."
96 (yahtml-define-begend-key-normal key env map)
97 (if YaTeX-inhibit-prefix-letter nil
98 (yahtml-define-begend-region-key
99 (concat (upcase (substring key 0 1)) (substring key 1)) env)))
102 (if yahtml-mode-map nil
103 (setq yahtml-mode-map (make-sparse-keymap)
104 yahtml-prefix-map (make-sparse-keymap))
105 (define-key yahtml-mode-map YaTeX-prefix yahtml-prefix-map)
106 (define-key yahtml-mode-map "\M-\C-@" 'yahtml-mark-begend)
107 (if (and (boundp 'window-system) (eq window-system 'x) YaTeX-emacs-19)
108 (define-key yahtml-mode-map [?\M-\C- ] 'yahtml-mark-begend))
109 (define-key yahtml-mode-map "\M-\C-a" 'YaTeX-beginning-of-environment)
110 (define-key yahtml-mode-map "\M-\C-e" 'YaTeX-end-of-environment)
111 (define-key yahtml-mode-map "\M-\C-m" 'yahtml-intelligent-newline)
112 (define-key yahtml-mode-map "\C-i" 'yahtml-indent-line)
113 (define-key yahtml-mode-map YaTeX-prefix yahtml-prefix-map)
114 (let ((map yahtml-prefix-map))
115 (YaTeX-define-key "^" 'yahtml-visit-main map)
116 (YaTeX-define-key "4^" 'yahtml-visit-main-other-window map)
117 (YaTeX-define-key "4g" 'yahtml-goto-corresponding-*-other-window map)
118 (YaTeX-define-key "44" 'YaTeX-switch-to-window map)
119 (and YaTeX-emacs-19 window-system
120 (progn
121 (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
122 (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
123 (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
124 (YaTeX-define-key "v" 'YaTeX-version map)
125 (YaTeX-define-key "}" 'YaTeX-insert-braces-region map)
126 (YaTeX-define-key "]" 'YaTeX-insert-brackets-region map)
127 (YaTeX-define-key ")" 'YaTeX-insert-parens-region map)
128 (YaTeX-define-key "s" 'yahtml-insert-form map)
129 (YaTeX-define-key "l" 'yahtml-insert-tag map)
130 (YaTeX-define-key "m" 'yahtml-insert-single map)
131 (YaTeX-define-key "n" '(lambda () (interactive) (insert "<br>\n")) map)
132 (if YaTeX-no-begend-shortcut
133 (progn
134 (YaTeX-define-key "B" 'yahtml-insert-begend-region map)
135 (YaTeX-define-key "b" 'yahtml-insert-begend map))
136 (yahtml-define-begend-key "bh" "HTML" map)
137 (yahtml-define-begend-key "bH" "HEAD" map)
138 (yahtml-define-begend-key "bt" "TITLE" map)
139 (yahtml-define-begend-key "bT" "table" map)
140 (yahtml-define-begend-key "bb" "BODY" map)
141 (yahtml-define-begend-key "bd" "DL" map)
142 (yahtml-define-begend-key "b1" "H1" map)
143 (yahtml-define-begend-key "b2" "H2" map)
144 (yahtml-define-begend-key "b3" "H3" map)
145 (yahtml-define-begend-key "ba" "a" map)
146 (yahtml-define-begend-key "bf" "form" map)
147 (yahtml-define-begend-key "bs" "select" map)
148 (YaTeX-define-key "b " 'yahtml-insert-begend map)
149 (YaTeX-define-key "B " 'yahtml-insert-begend-region map)
150 )
151 (YaTeX-define-key "e" 'YaTeX-end-environment map)
152 (YaTeX-define-key ">" 'yahtml-comment-region map)
153 (YaTeX-define-key "<" 'yahtml-uncomment-region map)
154 (YaTeX-define-key "g" 'yahtml-goto-corresponding-* map)
155 (YaTeX-define-key "k" 'yahtml-kill-* map)
156 (YaTeX-define-key "c" 'yahtml-change-* map)
157 (YaTeX-define-key "t" 'yahtml-browse-menu map)
158 (YaTeX-define-key "a" 'yahtml-complete-mark map)
159 ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
160 )
161 )
163 (defvar yahtml-paragraph-start
164 (concat
165 "^$\\|<[bh]r>\\|<p>\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|t[rdh]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\)>")
166 "*Regexp of html paragraph separater")
167 (defvar yahtml-paragraph-separate
168 (concat
169 "^$\\|<[bh]r>\\|<p>\\|^[ \t]*</?\\(h[1-6]\\|p\\|d[ldt]\\|li\\|body\\|html\\|head\\|title\\|ul\\|ol\\|dl\\|pre\\)>")
170 "*Regexp of html paragraph separater")
171 (defvar yahtml-syntax-table nil
172 "*Syntax table for typesetting buffer")
174 (if yahtml-syntax-table nil
175 (setq yahtml-syntax-table
176 (make-syntax-table (standard-syntax-table)))
177 (modify-syntax-entry ?\< "(" yahtml-syntax-table)
178 (modify-syntax-entry ?\> ")" yahtml-syntax-table)
179 (modify-syntax-entry ?\n " " yahtml-syntax-table)
180 )
181 (defvar yahtml-command-regexp "[A-Za-z0-9]+"
182 "Regexp of constituent of html commands.")
184 ;;; Completion tables for `form'
185 (defvar yahtml-form-table
186 '(("img") ("input")))
187 (defvar yahtml-user-form-table nil)
188 (defvar yahtml-tmp-form-table nil)
190 (defvar yahtml-env-table
191 '(("html") ("head") ("title") ("body") ("dl") ("a") ("form") ("select")
192 ("textarea")
193 ("OrderedList" . "ol")
194 ("UnorderedList" . "ul")
195 ("DefinitionList" . "dl")
196 ("Preformatted" . "pre")
197 ("table") ("tr") ("th") ("td")
198 ("h1") ("h2") ("h3") ("h4") ("h5") ("h6") ("ul")))
200 (defvar yahtml-itemizing-regexp
201 "\\(ul\\|ul\\|dl\\)"
202 "Regexp of itemizing forms")
204 (defvar yahtml-user-env-table nil)
205 (defvar yahtml-tmp-env-table nil)
207 ;;; Completion tables for typeface designator
208 (defvar yahtml-typeface-table
209 '(("defn") ("em") ("cite") ("code") ("kbd") ("samp")
210 ("strong") ("var") ("b") ("i") ("tt") ("u") ("address"))
211 "Default completion table of typeface designator")
212 (defvar yahtml-user-typeface-table nil)
213 (defvar yahtml-tmp-typeface-table nil)
214 (defvar yahtml-last-typeface-cmd "address")
216 (defvar yahtml-single-cmd-table
217 '(("hr") ("br") ("option") ("p")
218 ("HorizontalLine" . "hr")
219 ("BreakLine" . "br")
220 ("Paragraph" . "p")
221 ("Item" . "li")
222 ("DefineTerm" . "dt")
223 ("Description" . "dd")
224 ("dd") ("dt") ("li")
225 )
226 "Default completion table of HTML single command.")
227 (defvar yahtml-user-single-cmd-table nil)
228 (defvar yahtml-tmp-single-cmd-table nil)
229 (defvar yahtml-last-single-cmd nil)
231 (defvar yahtml-prefer-upcases nil)
232 (cond
233 (yahtml-prefer-upcases
234 (setq yahtml-form-table
235 (mapcar (function (lambda (list) (list (upcase (car list)))))
236 yahtml-form-table))
237 (setq yahtml-env-table
238 (mapcar (function (lambda (list) (list (upcase (car list)))))
239 yahtml-env-table))
240 (setq yahtml-typeface-table
241 (mapcar (function (lambda (list) (list (upcase (car list)))))
242 yahtml-typeface-table))))
244 (defvar yahtml-struct-name-regexp
245 "\\<\\(h[1-6]\\|[uod]l\\|body\\|title\\|head\\|table\\|t[rhd]\\|pre\\|a\\|form\\|select\\)\\b")
248 (defun yahtml-mode ()
249 (interactive)
250 (yatex-mode)
251 (cond
252 ((boundp 'MULE)
253 (set-file-coding-system
254 (cdr (assq yahtml-kanji-code YaTeX-kanji-code-alist))))
255 ((boundp 'NEMACS)
256 (make-local-variable 'kanji-fileio-code)
257 (setq kanji-fileio-code yahtml-kanji-code)))
258 (setq major-mode 'yahtml-mode
259 mode-name "yahtml")
260 (make-local-variable 'YaTeX-ec) (setq YaTeX-ec "")
261 (make-local-variable 'YaTeX-struct-begin)
262 (setq YaTeX-struct-begin "<%1%2>")
263 (make-local-variable 'YaTeX-struct-end) (setq YaTeX-struct-end "</%1>")
264 (make-local-variable 'YaTeX-struct-name-regexp)
265 (setq YaTeX-struct-name-regexp yahtml-struct-name-regexp)
266 (make-local-variable 'YaTeX-prefix-map)
267 (make-local-variable 'YaTeX-command-token-regexp)
268 (setq YaTeX-command-token-regexp yahtml-command-regexp)
269 (make-local-variable 'YaTeX-comment-prefix)
270 (setq YaTeX-comment-prefix "<!--")
271 ;;(make-local-variable 'YaTeX-environment-indent)
272 ;;(setq YaTeX-environment-indent 0)
273 (make-local-variable 'fill-prefix)
274 (setq fill-prefix nil)
275 (make-local-variable 'paragraph-separate)
276 (setq paragraph-start yahtml-paragraph-start
277 paragraph-separate yahtml-paragraph-separate)
278 (make-local-variable 'comment-start)
279 (make-local-variable 'comment-end)
280 (setq comment-start "<!-- " comment-end " -->")
281 (make-local-variable 'indent-line-function)
282 (setq indent-line-function 'yahtml-indent-line)
283 (make-local-variable 'YaTeX-item-regexp)
284 (setq YaTeX-item-regexp "<\\(li\\|d[td]\\)>")
285 (set-syntax-table yahtml-syntax-table)
286 (use-local-map yahtml-mode-map)
287 (run-hooks 'yahtml-mode-hook))
289 (defun yahtml-define-menu (keymap bindlist)
290 (mapcar
291 (function
292 (lambda (bind)
293 (define-key keymap (vector (car bind)) (cdr bind))))
294 bindlist))
296 (defvar yahtml-menu-map nil "Menu map of yahtml")
297 (defvar yahtml-menu-map-sectioning nil "Menu map of yahtml(sectioning)")
298 (defvar yahtml-menu-map-listing nil "Menu map of yahtml(listing)")
299 (defvar yahtml-menu-map-logical nil "Menu map of yahtml(logical tags)")
300 (defvar yahtml-menu-map-typeface nil "Menu map of yahtml(typeface tags)")
302 ;;; Variables for mosaic url history
303 (defvar yahtml-urls nil "Alist of global history")
304 (defvar yahtml-url-history-file "~/.mosaic-global-history"
305 "File name of url history")
307 (cond
308 ((and YaTeX-emacs-19 (null yahtml-menu-map))
309 (setq yahtml-menu-map (make-sparse-keymap "yahtml menu"))
310 (setq yahtml-menu-map-sectioning (make-sparse-keymap "sectioning menu"))
311 (yahtml-define-menu
312 yahtml-menu-map-sectioning
313 (nreverse
314 '((1 "H1" . (lambda () (interactive) (yahtml-insert-begend nil "H1")))
315 (2 "H2" . (lambda () (interactive) (yahtml-insert-begend nil "H2")))
316 (3 "H3" . (lambda () (interactive) (yahtml-insert-begend nil "H3")))
317 (4 "H4" . (lambda () (interactive) (yahtml-insert-begend nil "H4")))
318 (5 "H5" . (lambda () (interactive) (yahtml-insert-begend nil "H5")))
319 (6 "H6" . (lambda () (interactive) (yahtml-insert-begend nil "H6")))
320 )))
321 (setq yahtml-menu-map-logical (make-sparse-keymap "logical tags"))
322 (yahtml-define-menu
323 yahtml-menu-map-logical
324 (nreverse
325 '((em "Embolden" .
326 (lambda () (interactive) (yahtml-insert-tag nil "EM")))
327 (defn "Define a word" .
328 (lambda () (interactive) (yahtml-insert-tag nil "DEFN")))
329 (cite "Citation" .
330 (lambda () (interactive) (yahtml-insert-tag nil "CITE")))
331 (code "Code" .
332 (lambda () (interactive) (yahtml-insert-tag nil "CODE")))
333 (kbd "Keyboard" .
334 (lambda () (interactive) (yahtml-insert-tag nil "KBD")))
335 (samp "Sample display" .
336 (lambda () (interactive) (yahtml-insert-tag nil "SAMP")))
337 (strong "Strong" .
338 (lambda () (interactive) (yahtml-insert-tag nil "STRONG")))
339 (VAR "Variable notation" .
340 (lambda () (interactive) (yahtml-insert-tag nil "VAR")))
341 )))
342 (setq yahtml-menu-map-typeface (make-sparse-keymap "typeface tags"))
343 (yahtml-define-menu
344 yahtml-menu-map-typeface
345 (nreverse
346 '((b "Bold" .
347 (lambda () (interactive) (yahtml-insert-tag nil "B")))
348 (i "Italic" .
349 (lambda () (interactive) (yahtml-insert-tag nil "I")))
350 (tt "Typewriter" .
351 (lambda () (interactive) (yahtml-insert-tag nil "TT")))
352 (u "Underlined" .
353 (lambda () (interactive) (yahtml-insert-tag nil "U")))
354 )))
355 (setq yahtml-menu-map-listing (make-sparse-keymap "listing"))
356 (yahtml-define-menu
357 yahtml-menu-map-listing
358 (nreverse
359 '((ul "Unordered" .
360 (lambda () (interactive) (yahtml-insert-begend nil "UL")))
361 (ol "Ordered" .
362 (lambda () (interactive) (yahtml-insert-begend nil "OL")))
363 (dl "Definition" .
364 (lambda () (interactive) (yahtml-insert-begend nil "DL")))
365 )))
366 (setq yahtml-menu-map-item (make-sparse-keymap "item"))
367 (yahtml-define-menu
368 yahtml-menu-map-item
369 (nreverse
370 '((li "Simple item" .
371 (lambda () (interactive) (yahtml-insert-single "li")))
372 (dt "Define term" .
373 (lambda () (interactive) (yahtml-insert-single "dt")))
374 (dd "Description of term" .
375 (lambda () (interactive) (yahtml-insert-single "dd")))
376 )))
377 (define-key yahtml-mode-map [menu-bar yahtml]
378 (cons "yahtml" yahtml-menu-map))
379 (let ((keys (where-is-internal 'fill-paragraph global-map)))
380 (while keys
381 (define-key yahtml-mode-map (car keys) 'yahtml-fill-paragraph)
382 (setq keys (cdr keys))))
383 (yahtml-define-menu
384 yahtml-menu-map
385 (nreverse
386 (list
387 (cons (list 'sect "Sectioning")
388 (cons "sectioning" yahtml-menu-map-sectioning))
389 (cons (list 'list "Listing")
390 (cons "Listing" yahtml-menu-map-listing))
391 (cons (list 'item "Item")
392 (cons "Itemizing" yahtml-menu-map-item));;;
393 (cons (list 'logi "Logical tags")
394 (cons "logical" yahtml-menu-map-logical))
395 (cons (list 'type "Typeface tags")
396 (cons "typeface" yahtml-menu-map-typeface))
397 )))
398 ))
400 (defun yahtml-collect-url-history ()
401 "Collect urls from global history file."
402 (interactive)
403 (save-excursion
404 (set-buffer
405 (find-file-noselect (expand-file-name yahtml-url-history-file)))
406 (goto-char (point-min))
407 (setq yahtml-urls)
408 (message "Collecting global history...")
409 (while (re-search-forward "^[A-Za-z]+:" nil t)
410 (setq yahtml-urls
411 (cons (list
412 (buffer-substring
413 (progn (beginning-of-line) (point))
414 (progn (skip-chars-forward "^ ") (point))))
415 yahtml-urls)))
416 (message "Collecting global history...Done")))
418 ;;; ----------- Completion ----------
419 (defvar yahtml-last-begend "html")
420 (defun yahtml-insert-begend (&optional region env)
421 "Insert <cmd> ... </cmd>."
422 (interactive "P")
423 (let*((completion-ignore-case t)
424 (cmd
425 (or env
426 (YaTeX-cplread-with-learning
427 (format "Environment(default %s): " yahtml-last-begend)
428 'yahtml-env-table 'yahtml-user-env-table 'yahtml-tmp-env-table)))
429 (bolp (save-excursion
430 (skip-chars-backward " \t" (point-beginning-of-line)) (bolp)))
431 (cc (current-column)))
432 (if (string< "" cmd) (setq yahtml-last-begend cmd))
433 (setq yahtml-last-begend
434 (or (cdr (assoc yahtml-last-begend yahtml-env-table))
435 yahtml-last-begend))
436 (setq cmd yahtml-last-begend)
437 (if region
438 (let ((beg (region-beginning))
439 (end (region-end))
440 (addin (yahtml-addin cmd)))
441 (goto-char end)
442 (insert (format "</%s>%s" cmd (if bolp "\n" "")))
443 (goto-char beg)
444 (insert (format "<%s%s>%s" cmd addin (if bolp "\n" ""))))
445 (insert (format "<%s%s>" cmd (yahtml-addin cmd)))
446 (save-excursion
447 (if bolp (progn
448 (insert "\n")
449 (indent-to-column cc)
450 (insert (format "</%s>" cmd)))
451 (insert (format "</%s>" cmd))))
452 (if bolp (yahtml-intelligent-newline nil)))))
454 (defun yahtml-insert-begend-region ()
455 "Call yahtml-insert-begend in the region mode."
456 (interactive)
457 (yahtml-insert-begend t))
460 (defun yahtml-insert-form (&optional form)
461 "Insert <FORM option=\"argument\">."
462 (interactive)
463 (or form
464 (setq form
465 (YaTeX-cplread-with-learning
466 "Form: "
467 'yahtml-form-table 'yahtml-user-form-table
468 'yahtml-tmp-form-table)))
469 (let ((p (point)) q)
470 (insert (format "<%s%s>" form (yahtml-addin form)))
471 ;;(indent-relative-maybe)
472 (if (cdr (assoc form yahtml-form-table))
473 (save-excursion (insert (format "</%s>" form))))
474 (if (search-backward "\"\"" p t) (forward-char 1))))
476 ;;; ---------- Add-in ----------
477 (defun yahtml-addin (form)
478 "Check add-in function's existence and call it if exists."
479 (let ((addin (concat "yahtml:" (downcase form))) s)
480 (if (and (intern-soft addin) (fboundp (intern-soft addin))
481 (stringp (setq s (funcall (intern addin))))
482 (string< "" s))
483 (concat " " s)
484 "")))
487 (defvar yahtml-completing-buffer nil)
488 (defun yahtml-collect-labels (&optional file)
489 "Collect current buffers label (<a name=...>).
490 If optional argument FILE is specified collect labels in FILE."
491 (let (list)
492 (save-excursion
493 (set-buffer yahtml-completing-buffer)
494 (if file (set-buffer (find-file-noselect file)))
495 (save-excursion
496 (goto-char (point-min))
497 (while (re-search-forward "<a\\b" nil t)
498 (skip-chars-forward " \t\n")
499 (if (looking-at "name\\s *=\\s *\"?#?\\([^\">]+\\)\"?>")
500 (setq list (cons
501 (list (concat "#" (YaTeX-match-string 1)))
502 list))))
503 list)))
504 )
506 (defvar yahtml-url-completion-map nil "Key map used in URL completion buffer")
507 (if yahtml-url-completion-map nil
508 (setq yahtml-url-completion-map
509 (copy-keymap minibuffer-local-completion-map))
510 (define-key yahtml-url-completion-map "\t" 'yahtml-complete-url)
511 (define-key yahtml-url-completion-map " " 'yahtml-complete-url)
512 )
514 (defun yahtml-complete-url ()
515 "Complete external URL from history or local file name."
516 (interactive)
517 (let (initial i2 cmpl path dir file listfunc beg labels (p (point)))
518 (setq initial (buffer-string))
519 (cond
520 ((string-match "^http:" initial)
521 (setq cmpl (try-completion initial yahtml-urls)
522 listfunc (list 'lambda nil
523 (list 'all-completions initial 'yahtml-urls))
524 beg (point-min)))
525 ((setq beg (string-match "#" initial))
526 (or (equal beg 0) ;begin with #
527 (progn
528 (setq path (substring initial 0 beg))
529 (if (string-match "^/" path)
530 (setq path (yahtml-url-to-path path)))))
531 (setq initial (substring initial beg))
532 (setq labels (yahtml-collect-labels path)
533 cmpl (try-completion initial labels)
534 listfunc (list 'lambda ()
535 (list 'all-completions
536 initial (list 'quote labels)))
537 beg (+ (point-min) beg)))
538 (t
539 (setq path (if (string-match "^/" initial)
540 (yahtml-url-to-path initial)
541 initial))
542 (setq dir (or (file-name-directory path) ".")
543 file (file-name-nondirectory path)
544 initial file
545 cmpl (file-name-completion file dir)
546 listfunc (list 'lambda nil
547 (list 'file-name-all-completions
548 file dir))
549 beg (save-excursion (skip-chars-backward "^/") (point)))))
550 (cond
551 ((stringp cmpl)
552 (if (string= initial cmpl)
553 (with-output-to-temp-buffer "*Completions*"
554 (princ "Possible completinos are:\n")
555 (princ
556 (mapconcat '(lambda (x) x) (funcall listfunc) "\n")))
557 (delete-region (point) beg)
558 (insert cmpl)))
559 ((null cmpl)
560 (ding))
561 ((eq t cmpl)
562 (save-excursion
563 (unwind-protect
564 (progn
565 (goto-char p)
566 (insert " [Sole completion]"))
567 (delete-region p (point-max))))))))
569 (defun yahtml:a ()
570 "Add-in function for <a>"
571 (or yahtml-urls (yahtml-collect-url-history))
572 (setq yahtml-completing-buffer (current-buffer))
573 ; (concat "href=\""
574 ; (completing-read "href: " yahtml-urls)
575 ; "\"")
576 (message "(H)ref (N)ame?")
577 (cond
578 ((string-match "[nN]" (char-to-string (read-char)))
579 (concat "name=\"" (read-string "name: ") "\""))
580 (t
581 (concat "href=\""
582 (read-from-minibuffer "href: " "" yahtml-url-completion-map)
583 "\""))))
585 (defun yahtml:img ()
586 "Add-in function for <img>"
587 (or yahtml-urls (yahtml-collect-url-history))
588 (let ((src (read-file-name "src: " "" nil nil ""))
589 (alg (completing-read "align: " '(("top") ("middle") ("bottom"))))
590 (alt (read-string "alt: ")))
591 (concat "src=\"" src "\""
592 (if (string< "" alg) (concat " align=\"" alg "\""))
593 (if (string< "" alt) (concat " alt=\"" alt "\"")))))
595 (defun yahtml:form ()
596 "Add-in function `form' input format"
597 (concat
598 " method=" (completing-read "Method: " '(("POST") ("GET")) nil t)
599 " action=\"" (read-string "Action: ") "\""
600 ))
602 (defun yahtml:select ()
603 "Add-in function for `select' input format"
604 (setq yahtml-last-single-cmd "option")
605 (concat " name=\"" (read-string "name: ") "\""))
607 (defun yahtml:ol ()
608 (setq yahtml-last-single-cmd "li") "")
609 (defun yahtml:ul ()
610 (setq yahtml-last-single-cmd "li") "")
611 (defun yahtml:dl ()
612 (setq yahtml-last-single-cmd "dt") "")
613 (defun yahtml:dt ()
614 (setq yahtml-last-single-cmd "dd") "")
617 (defvar yahtml-input-types
618 '(("text") ("password") ("checkbox") ("radio") ("submit")
619 ("reset") ("image") ("hidden")))
621 (defun yahtml:input ()
622 "Add-in function for `input' form"
623 (let (name type value checked (size "") (maxlength ""))
624 (setq name (read-string "name: ")
625 type (completing-read "type (default=text): "
626 yahtml-input-types nil t)
627 value (read-string "value: "))
628 (if (string-match "text\\|password\\|^$" type)
629 (setq size (read-string "size: ")
630 maxlength (read-string "maxlength: ")))
631 (concat
632 "name=\"" name "\""
633 (if (string< "" type) (concat " type=\"" type "\""))
634 (if (string< "" value) (concat " value=\"" value "\""))
635 (if (string< "" size) (concat " size=\"" size "\""))
636 (if (string< "" maxlength) (concat " maxlength=\"" maxlength "\""))
637 )))
639 (defun yahtml:textarea ()
640 "Add-in function for `textarea'"
641 (interactive)
642 (let (name rows cols)
643 (setq name (read-string "Name: ")
644 cols (read-string "Columns: "
645 rows (read-string "Rows: ")))
646 (concat
647 (concat (if yahtml-prefer-upcases "NAME=" "name=")
648 "\"" name "\"")
649 (if (string< "" cols)
650 (concat " " (if yahtml-prefer-upcases "COLS" "cols") "=" cols))
651 (if (string< "" rows)
652 (concat " " (if yahtml-prefer-upcases "ROWS" "rows") "=" rows)))))
655 ;;; ---------- Simple tag ----------
656 (defun yahtml-insert-tag (region-mode &optional tag)
657 "Insert <TAG> </TAG> and put cursor inside of them."
658 (interactive "P")
659 (or tag
660 (setq tag
661 (YaTeX-cplread-with-learning
662 (format "Tag %s(default %s): "
663 (if region-mode "region: " "") yahtml-last-typeface-cmd)
664 'yahtml-typeface-table 'yahtml-user-typeface-table
665 'yahtml-tmp-typeface-table)))
666 (if (string= "" tag) (setq tag yahtml-last-typeface-cmd))
667 (setq tag (funcall (if yahtml-prefer-upcases 'upcase 'downcase) tag)
668 yahtml-last-typeface-cmd tag)
669 (if region-mode
670 (if (if (string< "19" emacs-version) (mark t) (mark))
671 (save-excursion
672 (if (> (point) (mark)) (exchange-point-and-mark))
673 (insert "<" tag ">")
674 (exchange-point-and-mark)
675 (insert "</" tag ">"))
676 (message "No mark set now"))
677 (insert (format "<%s> " tag))
678 (save-excursion (insert (format "</%s>" tag)))))
680 (defun yahtml-insert-single (cmd)
681 "Insert <CMD>."
682 (interactive
683 (list
684 (let ((completion-ignore-case t))
685 (YaTeX-cplread-with-learning
686 (format "Command%s: "
687 (if yahtml-last-single-cmd
688 (concat "(default " yahtml-last-single-cmd ")") ""))
689 'yahtml-single-cmd-table 'yahtml-user-single-cmd-table
690 'yahtml-tmp-single-cmd-table))))
691 (if (string< "" cmd) (setq yahtml-last-single-cmd cmd))
692 (setq cmd (funcall (if yahtml-prefer-upcases 'upcase 'downcase) cmd))
693 (setq yahtml-last-single-cmd
694 (or (cdr (assoc yahtml-last-single-cmd yahtml-single-cmd-table))
695 yahtml-last-single-cmd))
696 (insert (format "<%s>" yahtml-last-single-cmd)))
698 ;;; ---------- Jump ----------
699 (defun yahtml-on-href-p ()
700 "Check if point is on href clause."
701 (let ((p (point)) cmd)
702 (save-excursion
703 (or (bobp) (skip-chars-backward "^ \t\n"))
704 (and (looking-at "href\\s *=\\s *\"?\\([^\"> \t\n]+\\)\"?")
705 (< p (match-end 0))
706 (YaTeX-match-string 1)))))
708 (defun yahtml-netscape-sentinel (proc mes)
709 (cond
710 ((null (buffer-name (process-buffer proc)))
711 (set-process-buffer proc nil))
712 ((eq (process-status proc) 'exit)
713 (let ((cb (current-buffer)))
714 (set-buffer (process-buffer proc))
715 (goto-char (point-min))
716 (if (search-forward "not running" nil t)
717 (progn
718 (message "Starting netscape...")
719 (start-process
720 "browser" (process-buffer proc) shell-file-name "-c"
721 (format "%s %s" yahtml-www-browser
722 (get 'yahtml-netscape-sentinel 'url)))
723 (message "Starting netscape...Done")))
724 (set-buffer cb)))))
726 (defvar yahtml-browser-process nil)
728 (defun yahtml-browse-html (href)
729 "Call WWW Browser to see HREF."
730 (let ((pb "* WWW Browser *") (cb (current-buffer)))
731 (cond
732 ((string-match "[Nn]etscape" yahtml-www-browser)
733 (if (get-buffer pb)
734 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
735 (put 'yahtml-netscape-sentinel 'url href)
736 (set-process-sentinel
737 (setq yahtml-browser-process
738 (start-process
739 "browser" pb shell-file-name "-c"
740 (format "%s -remote 'openURL(%s)'" yahtml-www-browser href)))
741 'yahtml-netscape-sentinel))
742 ((and (string= "w3" yahtml-www-browser) (fboundp 'w3-fetch))
743 (w3-fetch href))
744 ((stringp yahtml-www-browser)
745 (if (eq (process-status yahtml-browser-process) 'run)
746 (message "%s is already running" yahtml-www-browser)
747 (setq yahtml-browser-process
748 (start-process
749 "browser" "* WWW Browser *" shell-file-name
750 (format "%s %s" yahtml-www-browser href)))))
751 (t
752 (message "Sorry, jump across http is not supported.")))))
754 (defun yahtml-goto-corresponding-href (&optional other)
755 "Go to corresponding name."
756 (let ((href (yahtml-on-href-p)) file name)
757 (if href
758 (cond
759 ((string-match "^http:" href)
760 (yahtml-browse-html href))
761 (t (setq file (substring href 0 (string-match "#" href)))
762 (if (string-match "#" href)
763 (setq name (substring href (1+ (string-match "#" href)))))
764 (if (string< "" file)
765 (progn
766 (if (string-match "/$" file)
767 (setq file (concat file yahtml-directory-index)))
768 (if (string-match "^/" file)
769 (setq file (yahtml-url-to-path file)))
770 (if other (YaTeX-switch-to-buffer-other-window file)
771 (YaTeX-switch-to-buffer file))))
772 (if name
773 (progn (set-mark-command nil) (yahtml-jump-to-name name)))
774 t)))))
776 (defun yahtml-jump-to-name (name)
777 "Jump to html's named tag."
778 (setq name (format "name\\s *=\\s *\"?%s\"?" name))
779 (or (and (re-search-forward name nil t) (goto-char (match-beginning 0)))
780 (and (re-search-backward name nil t) (goto-char (match-beginning 0)))
781 (message "Named tag `%s' not found" (substring href 1))))
783 (defun yahtml-on-begend-p (&optional p)
784 "Check if point is on begend clause."
785 (let ((p (point)) cmd (case-fold-search t))
786 (save-excursion
787 (if p (goto-char p))
788 (if (equal (char-after (point)) ?<) (forward-char 1))
789 (if (and (re-search-backward "<" nil t)
790 (looking-at
791 (concat "<\\(/?" yahtml-command-regexp "\\)\\b"))
792 (condition-case nil
793 (forward-list 1)
794 (error nil))
795 (< p (point)))
796 (YaTeX-match-string 1)))))
798 (defun yahtml-goto-corresponding-begend (&optional noerr)
799 "Go to corresponding opening/closing tag.
800 Optional argument NOERR causes no error for unballanced tag."
801 (let ((cmd (yahtml-on-begend-p)) m0
802 (p (point)) (case-fold-search t) func str (nest 0))
803 (cond
804 (cmd
805 (setq m0 (match-beginning 0))
806 (if (= (aref cmd 0) ?/) ;on </cmd> line
807 (setq cmd (substring cmd 1)
808 str (format "\\(<%s\\)\\|\\(</%s\\)" cmd cmd)
809 func 're-search-backward)
810 (setq str (format "\\(</%s\\)\\|\\(<%s\\)" cmd cmd)
811 func 're-search-forward))
812 (while (and (>= nest 0) (funcall func str nil t))
813 (if (equal m0 (match-beginning 0))
814 nil
815 (setq nest (+ nest (if (match-beginning 1) -1 1)))))
816 (if (< nest 0)
817 (goto-char (match-beginning 0))
818 (funcall
819 (if noerr 'message 'error)
820 "Corresponding tag of `%s' not found." cmd)
821 (goto-char p)
822 nil))
823 (t nil))))
825 (defun yahtml-current-tag ()
826 "Return the current tag name."
827 (save-excursion
828 (let ((p (point)) b tag)
829 (or (bobp)
830 (looking-at "<")
831 (progn (skip-chars-backward "^<") (forward-char -1)))
832 (setq b (point))
833 (skip-chars-forward "<")
834 (setq tag (buffer-substring
835 (point) (progn (skip-chars-forward "^ \t\n") (point))))
836 (goto-char b)
837 (forward-list 1)
838 (and (< p (point)) tag))))
841 (defun yahtml-goto-corresponding-img ()
842 "View image on point"
843 (let ((tag (yahtml-current-tag)) image (p (point)) (case-fold-search t))
844 (if (and tag
845 (string-match "img" tag)
846 (save-excursion
847 (re-search-backward "<\\s *img" nil t)
848 (re-search-forward "src=\"?\\([^\"> ]+\\)\"?")
849 (match-beginning 1)
850 (setq image
851 (buffer-substring (match-beginning 1) (match-end 1)))))
852 (progn
853 (message "Invoking %s %s..." yahtml-image-viewer image)
854 (start-process
855 "Viewer" " * Image Viewer *" shell-file-name "-c"
856 (concat yahtml-image-viewer " " image))
857 (message "Invoking %s %s...Done" yahtml-image-viewer image)))))
859 (defun yahtml-goto-corresponding-* (&optional other)
860 "Go to corresponding object."
861 (interactive)
862 (cond
863 ((yahtml-goto-corresponding-href other))
864 ((yahtml-goto-corresponding-img))
865 ((yahtml-goto-corresponding-begend))
866 ))
868 (defun yahtml-goto-corresponding-*-other-window ()
869 "Go to corresponding object."
870 (interactive)
871 (yahtml-goto-corresponding-* t))
873 ;;; ---------- killing ----------
874 (defun yahtml-kill-begend (&optional whole)
875 (let ((tag (yahtml-on-begend-p)) (p (make-marker)) (q (make-marker)))
876 (if tag
877 (progn
878 (or (looking-at "<")
879 (progn (skip-chars-backward "^<") (forward-char -1)))
880 (set-marker p (point))
881 (yahtml-goto-corresponding-begend)
882 (or (looking-at "<")
883 (progn (skip-chars-backward "^<") (forward-char -1)))
884 (delete-region (point) (progn (forward-list 1) (point)))
885 (set-marker q (point))
886 (beginning-of-line)
887 (if (looking-at "^\\s *$")
888 (delete-region (point) (progn (forward-line 1) (point))))
889 (goto-char p)
890 (delete-region (point) (progn (forward-list 1) (point)))
891 (if (looking-at "^\\s *$")
892 (delete-region (point) (progn (forward-line 1) (point))))
893 (if whole (delete-region p q))
894 tag))))
896 (defun yahtml-kill-* (whole)
897 "Kill current position's HTML tag (set)."
898 (interactive "P")
899 (cond
900 ((yahtml-kill-begend whole))
901 ))
904 ;;; ---------- changing ----------
905 (defun yahtml-change-begend ()
906 (let ((tag (yahtml-on-begend-p))
907 (completion-ignore-case t)
908 (p (point)) (q (make-marker))
909 (default (append yahtml-env-table yahtml-typeface-table))
910 (user (append yahtml-user-env-table yahtml-user-typeface-table))
911 (tmp (append yahtml-tmp-env-table yahtml-tmp-typeface-table))
912 href b1 e1)
913 (cond
914 (tag
915 (cond
916 ((and (equal tag "a")
917 (save-excursion
918 (and
919 (re-search-backward "<a" nil t)
920 (goto-char (match-end 0))
921 (skip-chars-forward " \t\n")
922 (>= p (point))
923 (looking-at "href\\s *=\\s *\"?\\([^\"> \t\n]+\\)\"?")
924 (< p (match-end 0)))))
925 (setq b1 (match-beginning 1) e1 (match-end 1)
926 href (read-from-minibuffer
927 "Change href to: " "" yahtml-url-completion-map))
928 (if (string< "" href)
929 (progn
930 (delete-region b1 e1)
931 (goto-char b1)
932 (insert href))))
933 (t
934 (save-excursion
935 (if (= (aref tag 0) ?/) (setq tag (substring tag 1)))
936 (or (= (char-after (point)) ?<) (skip-chars-backward "^<"))
937 (skip-chars-forward "^A-Za-z")
938 (set-marker q (point))
939 (setq p (point))
940 (yahtml-goto-corresponding-begend)
941 (or (= (char-after (point)) ?<)
942 (skip-chars-backward "^<"))
943 (skip-chars-forward "^A-Za-z")
944 (if (= (char-after (1- (point))) ?/)
945 (progn
946 (set-marker q (point))
947 (goto-char p)))
948 (setq tag (YaTeX-cplread-with-learning
949 (format "Change `%s' to(default %s): "
950 tag yahtml-last-begend)
951 'default 'user 'tmp))
952 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
953 (if (string= "" tag) (setq tag yahtml-last-begend))
954 (setq yahtml-last-begend
955 (or (cdr (assoc tag yahtml-env-table)) tag)
956 tag yahtml-last-begend)
957 (insert (format "%s%s" tag (yahtml-addin tag)))
958 (goto-char q)
959 (delete-region (point) (progn (skip-chars-forward "^>") (point)))
960 (insert tag))))))))
962 (defun yahtml-change-* ()
963 "Change current position's HTML tag (set)."
964 (interactive)
965 (cond
966 ((yahtml-change-begend))
967 ))
969 ;;; ---------- commenting ----------
970 (defun yahtml-comment-region (beg end)
971 (interactive "r")
972 (comment-region beg end nil))
974 (defun yahtml-uncomment-region (beg end)
975 (interactive "r")
976 (comment-region beg end '(4)))
980 ;;; ---------- filling ----------
981 (defun yahtml-fill-paragraph (arg)
982 (interactive "P")
983 (let ((case-fold-search t) (p (point)))
984 (save-excursion
985 (fill-region-as-paragraph
986 (progn (re-search-backward paragraph-start nil t)
987 (or (save-excursion
988 (goto-char (match-end 0))
989 (if (looking-at "[ \t]*$")
990 (progn (forward-line 1) (point))))
991 (point)))
992 (progn (goto-char p)
993 (re-search-forward paragraph-start nil t)
994 (match-beginning 0))))))
996 ;;;
997 ;;; ---------- indentation ----------
998 ;;;
999 (defvar yahtml-hate-too-deep-indentation nil)
1000 (defun yahtml-indent-line ()
1001 (interactive)
1002 (let ((envs "[uod]l\\|table\\|t[rhd]\\|select\\|a\\b")
1003 (itms "<\\(dt\\|dd\\|li\\|t[rdh]\\|option\\)>")
1004 inenv p col peol (case-fold-search t))
1005 (save-excursion
1006 (beginning-of-line)
1007 (setq inenv (or (YaTeX-inner-environment) "html")
1008 col (get 'YaTeX-inner-environment 'indent)
1009 p (get 'YaTeX-inner-environment 'point)
1010 op))
1011 (save-excursion
1012 (cond
1013 ((string-match envs inenv)
1014 (save-excursion
1015 (beginning-of-line)
1016 (skip-chars-forward " \t")
1017 (cond
1018 ((looking-at (concat "</\\(" envs "\\)>"))
1019 (YaTeX-reindent col))
1020 ((or (looking-at itms)
1021 (and yahtml-hate-too-deep-indentation
1022 (looking-at (concat "<" envs))))
1023 (YaTeX-reindent (+ col YaTeX-environment-indent)))
1024 ((and (< p (point))
1025 (save-excursion
1026 (and
1027 ;;(re-search-backward itms p t)
1028 (setq op (point))
1029 (goto-char p)
1030 (re-search-forward itms op t)
1031 (goto-char (match-end 0))
1032 (skip-chars-forward " \t")
1033 (setq col (current-column)))))
1034 (YaTeX-reindent col))
1035 (t
1036 (YaTeX-reindent (+ col YaTeX-environment-indent)))))))
1037 (and (bolp) (skip-chars-forward " \t"))
1038 (if (and (setq inenv (yahtml-on-begend-p))
1039 (string-match (concat "^\\(" envs "\\)") inenv))
1040 (save-excursion
1041 (setq peol (point-end-of-line))
1042 (or (= (char-after (point)) ?<)
1043 (progn (skip-chars-backward "^<") (forward-char -1)))
1044 (setq col (current-column))
1045 (if (and (yahtml-goto-corresponding-begend t)
1046 (> (point) peol)) ;if on the different line
1047 (YaTeX-reindent col)))))
1048 (and (bolp) (skip-chars-forward " \t"))))
1050 ;(defun yahtml-fill-item ()
1051 ; "Fill item HTML version"
1052 ; (interactive)
1053 ; (let (inenv p fill-prefix peol (case-fold-search t))
1054 ; (setq inenv (or (YaTeX-inner-environment) "html")
1055 ; p (get 'YaTeX-inner-environment 'point))
1056 ; (cond
1057 ; ((string-match "^[uod]l" inenv)
1058 ; (save-excursion
1059 ; (if (re-search-backward "<\\(d[td]\\|li\\)>[ \t\n]*" p t)
1060 ; (progn
1061 ; (goto-char (match-end 0))
1062 ; (setq col (current-column)))
1063 ; (error "No <li>, <dt>, <dd>")))
1064 ; (save-excursion
1065 ; (end-of-line)
1066 ; (setq peol (point))
1067 ; (newline)
1068 ; (indent-to-column col)
1069 ; (setq fill-prefix (buffer-substring (point) (1+ peol)))
1070 ; (delete-region (point) peol)
1071 ; (fill-region-as-paragraph
1072 ; (progn (re-search-backward paragraph-start nil t) (point))
1073 ; (progn (re-search-forward paragraph-start nil t 2)
1074 ; (match-beginning 0)))))
1075 ; (t nil))))
1077 ;;;
1078 ;;; ---------- Browsing ----------
1079 ;;;
1080 (defun yahtml-browse-menu ()
1081 "Browsing menu"
1082 (interactive)
1083 (message "B)rowse R)eload...")
1084 (let ((c (char-to-string (read-char))))
1085 (cond
1086 ((string-match "[bj]" c)
1087 (yahtml-browse-current-file))
1088 ((string-match "r" c)
1089 (yahtml-browse-reload)))))
1091 (defun yahtml-file-to-url (file)
1092 "Convert local unix file name to URL.
1093 If no matches found in yahtml-path-url-alist, return raw file name."
1094 (let ((list yahtml-path-url-alist) p url)
1095 (if (file-directory-p file)
1096 (setq file (expand-file-name yahtml-directory-index file))
1097 (setq file (expand-file-name file)))
1098 (while list
1099 (if (string-match (concat "^" (regexp-quote (car (car list)))) file)
1100 (setq url (cdr (car list))
1101 file (substring file (match-end 0))
1102 url (concat url file)
1103 list nil))
1104 (setq list (cdr list)))
1105 (or url (concat "file:" file))))
1107 (defun yahtml-url-to-path (file &optional basedir)
1108 "Convert local URL name to unix file name."
1109 (let ((list yahtml-path-url-alist) url realpath docroot
1110 (dirsufp (string-match "/$" file)))
1111 (setq basedir (or basedir
1112 (file-name-directory
1113 (expand-file-name default-directory))))
1114 (cond
1115 ((string-match "^/" file)
1116 (while list
1117 (if (file-directory-p (car (car list)))
1118 (progn
1119 (setq url (cdr (car list)))
1120 (if (string-match "\\(http://[^/]*\\)/" url)
1121 (setq docroot (substring url (match-end 1)))
1122 (setq docroot url))
1123 (if (string-match (concat "^" (regexp-quote docroot)) file)
1124 (setq realpath
1125 (expand-file-name
1126 (substring
1127 file
1128 (if (= (aref file (1- (match-end 0))) ?/)
1129 (match-end 0) ; "/foo"
1130 (min (1+ (match-end 0)) (length file)))) ; "/~foo"
1131 (car (car list)))))
1132 (if realpath
1133 (progn (setq list nil)
1134 (if (and dirsufp (not (string-match "/$" realpath)))
1135 (setq realpath (concat realpath "/")))))))
1136 (setq list (cdr list)))
1137 realpath)
1138 (t file))))
1140 (defun yahtml-browse-current-file ()
1141 "Call WWW browser on current file."
1142 (interactive)
1143 (basic-save-buffer)
1144 (yahtml-browse-html (yahtml-file-to-url (buffer-file-name))))
1146 (defun yahtml-browse-reload ()
1147 "Send `reload' event to netzscape."
1148 (let ((pb "* WWW Browser *") (cb (current-buffer)))
1149 (cond
1150 ((string-match "[Nn]etscape" yahtml-www-browser)
1151 (if (get-buffer pb)
1152 (progn (set-buffer pb) (erase-buffer) (set-buffer cb)))
1153 ;;(or (get 'yahtml-netscape-sentinel 'url)
1154 ;; (error "Reload should be called after Browsing."))
1155 (put 'yahtml-netscape-sentinel 'url
1156 (yahtml-file-to-url (buffer-file-name)))
1157 (basic-save-buffer)
1158 (set-process-sentinel
1159 (setq yahtml-browser-process
1160 (start-process
1161 "browser" pb shell-file-name "-c"
1162 (format "%s -remote 'reload'" yahtml-www-browser)))
1163 'yahtml-netscape-sentinel))
1164 (t
1165 (message "Sorry, RELOAD is supported only for Netscape.")))))
1167 ;;; ---------- Intelligent newline ----------
1168 (defun yahtml-intelligent-newline (arg)
1169 "Intelligent newline for HTML"
1170 (interactive "P")
1171 (let ((env (downcase (or (YaTeX-inner-environment) "html"))) func)
1172 (setq func (intern-soft (concat "yahtml-intelligent-newline-" env)))
1173 (end-of-line)
1174 (newline)
1175 (if (and env func (fboundp func))
1176 (funcall func))))
1178 (defun yahtml-intelligent-newline-ul ()
1179 (interactive)
1180 (insert (if yahtml-prefer-upcases "<LI> " "<li> "))
1181 (yahtml-indent-line))
1183 (fset 'yahtml-intelligent-newline-ol 'yahtml-intelligent-newline-ul)
1185 (defun yahtml-intelligent-newline-dl ()
1186 (interactive)
1187 (let ((case-fold-search t))
1188 (if (save-excursion
1189 (re-search-backward "<\\(\\(dt\\)\\|\\(dd\\)\\)>"
1190 (get 'YaTeX-inner-environment 'point) t))
1191 (cond
1192 ((match-beginning 2)
1193 (insert (if yahtml-prefer-upcases "<DD> " "<dd> "))
1194 (setq yahtml-last-single-cmd "dt"))
1195 ((match-beginning 3)
1196 (insert (if yahtml-prefer-upcases "<DT> " "<dt> "))
1197 (setq yahtml-last-single-cmd "dd")))
1198 (insert (if yahtml-prefer-upcases "<DT> " "<dt> ")))
1199 (yahtml-indent-line)))
1201 (defun yahtml-intelligent-newline-select ()
1202 (interactive)
1203 (insert "<" (if yahtml-prefer-upcases "OPTION" "option") "> ")
1204 (yahtml-indent-line))
1206 ;;; ---------- Marking ----------
1207 (defun yahtml-mark-begend ()
1208 "Mark current tag"
1209 (interactive)
1210 (YaTeX-beginning-of-environment)
1211 (let ((p (point)))
1212 (save-excursion
1213 (skip-chars-backward " \t" (point-beginning-of-line))
1214 (if (bolp) (setq p (point))))
1215 (push-mark p t))
1216 (yahtml-goto-corresponding-begend)
1217 (forward-list 1)
1218 (if (eolp) (forward-char 1)))
1220 ;;; ---------- complete marks ----------
1221 (defun yahtml-complete-mark ()
1222 "Complete >, <, &asterisk, and "e."
1223 (interactive)
1224 (message "1:< 2:> 3:& 4:\"")
1225 (let ((c (read-char)))
1226 (setq c (if (or (< c ?0) (> c ?5))
1227 (string-match (regexp-quote (char-to-string c)) "<>&\"")
1228 (- c ?1)))
1229 (if (or (< c 0) (> c 4))
1230 nil
1231 (insert (format "&%s;" (nth c '("lt" "gt" "amp" "quot")))))))
1234 ;;; ---------- ----------
1235 ;;; ---------- ----------
1237 ;;;
1238 ;;hilit19
1239 ;;;
1240 (defvar yahtml-default-face-table
1241 '(
1242 (form black/ivory white/hex-442233 italic)
1243 ))
1244 (defvar yahtml-hilit-patterns-alist
1245 '(
1246 ;; comments
1247 ("<!--\\s " "-->" comment)
1248 ;; include&exec
1249 ("<!--#\\(include\\|exec\\)" "-->" include)
1250 ;; string
1251 (hilit-string-find 39 string)
1252 (yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
1253 ("</?[uod]l>" 0 decl)
1254 ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
1255 ("<a\\s +href" "</a>" crossref)
1256 ("</?\\sw+>" 0 decl)
1257 ("<form" "</form" form)
1258 ))
1260 (defun yahtml-hilit-region-tag (tag)
1261 "Return list of start/end point of <TAG> form."
1262 (if (re-search-forward (concat "<" tag ">") nil t)
1263 (let ((m0 (match-beginning 0)))
1264 (skip-chars-forward " \t\n")
1265 (cons (point)
1266 (progn (re-search-forward (concat "</" tag ">") nil t)
1267 (match-beginning 0))))))
1269 ;(setq hilit-patterns-alist (delq (assq 'yahtml-mode hilit-patterns-alist) hilit-patterns-alist))
1270 (cond
1271 ((and (featurep 'hilit19) (featurep 'yatex19))
1272 (or (assq 'yahtml-mode hilit-patterns-alist)
1273 (setq hilit-patterns-alist
1274 (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
1275 hilit-patterns-alist)))))
1277 (provide 'yahtml)
1279 ; Local variables:
1280 ; fill-prefix: ";;; "
1281 ; paragraph-start: "^$\\| \\|;;;$"
1282 ; paragraph-separate: "^$\\| \\|;;;$"
1283 ; End: