yatex

diff yahtml.el @ 72:0aaebd07dad0

Support font-lock on XEmacs-21, Emacs-20, Emacs-21. Support Emacs-21.
author yuuji
date Mon, 25 Dec 2000 10:19:28 +0000
parents 44e3a5e1e883
children f41b01fef5d6
line diff
     1.1 --- a/yahtml.el	Sun Apr 09 03:37:47 2000 +0000
     1.2 +++ b/yahtml.el	Mon Dec 25 10:19:28 2000 +0000
     1.3 @@ -1,8 +1,11 @@
     1.4  ;;; -*- Emacs-Lisp -*-
     1.5  ;;; (c ) 1994-2000 by HIROSE Yuuji [yuuji@yatex.org]
     1.6 -;;; Last modified Wed Mar  1 23:28:22 2000 on firestorm
     1.7 +;;; Last modified Mon Dec 25 18:56:49 2000 on firestorm
     1.8  ;;; $Id$
     1.9  
    1.10 +(defconst yahtml-revision-number "1.69"
    1.11 +  "Revision number of running yahtml.el")
    1.12 +
    1.13  ;;;[Installation]
    1.14  ;;; 
    1.15  ;;; First, you have to install YaTeX and make sure it works fine.  Then
    1.16 @@ -135,6 +138,8 @@
    1.17  ;;;  * [prefix] :	指定したリジョン中で上と逆の変換をします。
    1.18  ;;;  * [prefix] #	指定したリジョン中で%エンコードの必要な文字が
    1.19  ;;;			あればそれらをエンコードします。
    1.20 +;;;  * [prefix] ESC	yahtml-mode を抜け yahtml-mode に入る前に動作し
    1.21 +;;;			ていたメジャーモードに戻ります。
    1.22  ;;; 
    1.23  ;;; [謝辞]
    1.24  ;;; 
    1.25 @@ -221,8 +226,25 @@
    1.26  %x: width, %y: height, %s: size in bytes, %c: first comment string,
    1.27  %f: filename")
    1.28  
    1.29 -(defvar yahtml-use-hilit19 (featurep 'hilit19)
    1.30 -  "*Use hilit19 to fontify buffer or not")
    1.31 +(defvar yahtml-faithful-to-htmllint nil)
    1.32 +(defvar yahtml-error-line-regexp
    1.33 +  "^\\(.*\\)(\\([0-9]+\\)):\\|^line \\([0-9]+\\)"
    1.34 +  "*Regexp of error position which is produced by lint program.")
    1.35 +
    1.36 +(defvar yahtml-translate-hyphens-when-comment-region t
    1.37 +  "*Non-nil for translate hyphens to - when comment-region")
    1.38 +(defvar yahtml-escape-chars 'ask
    1.39 +  "*Escape reserved characters to URL-encoding or not.
    1.40 +Nil for never, t for everytime, and 'ask for inquiring
    1.41 +at each reserved chars.")
    1.42 +
    1.43 +(defvar yahtml-use-font-lock (and (featurep 'font-lock)
    1.44 +				  (fboundp 'font-lock-fontify-region))
    1.45 +  "*Non-nil means to use font-lock to fontify buffer.")
    1.46 +
    1.47 +(defvar yahtml-use-hilit19 (and (featurep 'hilit19)
    1.48 +				(not yahtml-use-font-lock))
    1.49 +  "*Non-nil means to Use hilit19 to highlight buffer")
    1.50  
    1.51  ;;; --- customizable variable ends here ---
    1.52  (defvar yahtml-prefix-map nil)
    1.53 @@ -231,7 +253,7 @@
    1.54  (defvar yahtml-shell-command-option
    1.55    (or (and (boundp 'shell-command-option) shell-command-option)
    1.56        (if (eq system-type 'ms-dos) "/c" "-c")))
    1.57 -
    1.58 +(defvar yahtml-use-highlighting (or yahtml-use-font-lock yahtml-use-hilit19))
    1.59  
    1.60  (defun yahtml-define-begend-key-normal (key env &optional map)
    1.61    "Define short cut yahtml-insert-begend key."
    1.62 @@ -276,10 +298,7 @@
    1.63  	   (YaTeX-define-key "5^" 'yahtml-visit-main-other-frame map)
    1.64  	   (YaTeX-define-key "5g" 'yahtml-goto-corresponding-*-other-frame map)
    1.65  	   (YaTeX-define-key "55" 'YaTeX-switch-to-window map)))
    1.66 -    (YaTeX-define-key "v" 'YaTeX-version map)
    1.67 -    (YaTeX-define-key "}" 'YaTeX-insert-braces-region map)
    1.68 -    (YaTeX-define-key "]" 'YaTeX-insert-brackets-region map)
    1.69 -    (YaTeX-define-key ")" 'YaTeX-insert-parens-region map)
    1.70 +    (YaTeX-define-key "v" 'yahtml-version map)
    1.71      (YaTeX-define-key "s" 'yahtml-insert-form map)
    1.72      (YaTeX-define-key "l" 'yahtml-insert-tag map)
    1.73      (YaTeX-define-key "L" 'yahtml-insert-tag-region map)
    1.74 @@ -321,11 +340,12 @@
    1.75      (YaTeX-define-key ":" 'yahtml-translate-reverse-region map)
    1.76      (YaTeX-define-key "#" 'yahtml-escape-chars-region map)
    1.77      ;;;;;(YaTeX-define-key "i" 'yahtml-fill-item map)
    1.78 +    (YaTeX-define-key "\e" 'yahtml-quit map)
    1.79      )
    1.80 -  (let ((keys (where-is-internal 'fill-paragraph global-map)))
    1.81 -    (while keys
    1.82 -      (define-key yahtml-mode-map (car keys) 'yahtml-fill-paragraph)
    1.83 -      (setq keys (cdr keys)))))
    1.84 +  (substitute-all-key-definition
    1.85 +   'fill-paragraph 'yahtml-fill-paragraph yahtml-mode-map)
    1.86 +  (substitute-all-key-definition
    1.87 +   'kill-buffer 'YaTeX-kill-buffer yahtml-mode-map))
    1.88  
    1.89  (if yahtml-lint-buffer-map nil
    1.90    (setq yahtml-lint-buffer-map (make-keymap))
    1.91 @@ -517,19 +537,27 @@
    1.92  		  yahtml-directory-index
    1.93  		(list yahtml-directory-index)))))))
    1.94  
    1.95 +(defvar yahtml-mode-old-mode nil)
    1.96  (defun yahtml-mode ()
    1.97    (interactive)
    1.98 +  (kill-all-local-variables)
    1.99    (let ((coding (or (yahtml-dir-default-charset) yahtml-kanji-code)))
   1.100      (cond
   1.101       ((and YaTeX-emacs-20 (boundp 'buffer-file-coding-system))
   1.102 -      (setq buffer-file-coding-system coding))
   1.103 +      (setq buffer-file-coding-system
   1.104 +	    (or (and (fboundp 'set-auto-coding) buffer-file-name
   1.105 +		     (save-excursion (set-auto-coding buffer-file-name 2000)))
   1.106 +		coding)))
   1.107       ((featurep 'mule)
   1.108        (set-file-coding-system coding))
   1.109       ((boundp 'NEMACS)
   1.110        (make-local-variable 'kanji-fileio-code)
   1.111        (setq kanji-fileio-code coding))))
   1.112 +  (if (not (eq 'yahtml-mode major-mode))
   1.113 +      (set (make-local-variable 'yahtml-mode-old-mode) major-mode))
   1.114    (setq major-mode 'yahtml-mode
   1.115 -	mode-name "yahtml")
   1.116 +	mode-name "yahtml"
   1.117 +	YaTeX-current-file-name (file-name-nondirectory (buffer-file-name)))
   1.118    (mapcar
   1.119     (function (lambda (x)
   1.120  	       (make-local-variable (car x))
   1.121 @@ -551,6 +579,19 @@
   1.122       (comment-start-skip . comment-start)
   1.123       (indent-line-function . yahtml-indent-line)))
   1.124  
   1.125 +  (if yahtml-use-font-lock
   1.126 +      (progn
   1.127 +	(yahtml-font-lock-set-default-keywords)
   1.128 +	(or (featurep 'xemacs)
   1.129 +	    (progn
   1.130 +	      (set (make-local-variable 'font-lock-defaults)
   1.131 +		   '(yahtml-font-lock-keywords nil t))
   1.132 +	      ;;(font-lock-mode -1)
   1.133 +	      (font-lock-mode 1) ;;Why should I fontify again???
   1.134 +	      ;; in yatex-mode, there's no need to refontify...
   1.135 +	      (font-lock-fontify-buffer)
   1.136 +	      ))
   1.137 +	))
   1.138    (set-syntax-table yahtml-syntax-table)
   1.139    (use-local-map yahtml-mode-map)
   1.140    (YaTeX-read-user-completion-table)
   1.141 @@ -559,7 +600,29 @@
   1.142    (and (= 0 (buffer-size)) (file-exists-p yahtml-template-file)
   1.143         (y-or-n-p (format "Insert %s?" yahtml-template-file))
   1.144         (insert-file-contents (expand-file-name yahtml-template-file)))
   1.145 -  (run-hooks 'text-mode-hook 'yahtml-mode-hook))
   1.146 +  (run-hooks 'text-mode-hook 'yahtml-mode-hook)
   1.147 +
   1.148 +  ;; This warning should be removed after a while(2000/12/2)
   1.149 +  (let ((fld (or (and (local-variable-p 'font-lock-defaults (current-buffer))
   1.150 +		      font-lock-defaults)
   1.151 +		 (get 'yahtml-mode 'font-lock-defaults))))
   1.152 +    (and fld (not (memq 'yahtml-font-lock-keywords fld))
   1.153 +	 (YaTeX-warning-font-lock "yahtml"))))
   1.154 +
   1.155 +(defun yahtml-version ()
   1.156 +  "Return string of the version of running yahtml."
   1.157 +  (interactive)
   1.158 +  (message
   1.159 +   (concat "Yet Another HTML-mode "
   1.160 +	   (if YaTeX-japan "「HTML屋」" "`yahtml'")
   1.161 +	   " Revision "
   1.162 +	   yahtml-revision-number)))
   1.163 +
   1.164 +(defun yahtml-quit ()
   1.165 +  (interactive)
   1.166 +  (and yahtml-mode-old-mode
   1.167 +       (fboundp yahtml-mode-old-mode)
   1.168 +       (funcall yahtml-mode-old-mode)))
   1.169  
   1.170  (defun yahtml-define-menu (keymap bindlist)
   1.171    (cond
   1.172 @@ -817,8 +880,9 @@
   1.173  (defun yahtml-complete-url ()
   1.174    "Complete external URL from history or local file name."
   1.175    (interactive)
   1.176 -  (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels)
   1.177 -    (setq initial (buffer-string))
   1.178 +  (let ((p (point)) initial i2 cmpl path dir file listfunc beg labels
   1.179 +	(lim (YaTeX-minibuffer-begin)))
   1.180 +    (setq initial (YaTeX-minibuffer-string))
   1.181      (cond
   1.182       ((string-match "^http:" initial)
   1.183        (setq cmpl (try-completion initial yahtml-urls)
   1.184 @@ -849,7 +913,7 @@
   1.185  	    listfunc (list 'lambda nil
   1.186  			   (list 'file-name-all-completions
   1.187  				 file dir))
   1.188 -	    beg (save-excursion (skip-chars-backward "^/") (point)))))
   1.189 +	    beg (save-excursion (skip-chars-backward "^/" lim) (point)))))
   1.190      (cond
   1.191       ((stringp cmpl)
   1.192        (if (string= initial cmpl)
   1.193 @@ -869,11 +933,6 @@
   1.194  	      (insert " [Sole completion]"))
   1.195  	  (delete-region p (point-max))))))))
   1.196  
   1.197 -(defvar yahtml-escape-chars 'ask
   1.198 -  "*Escape reserved characters to URL-encoding or not.
   1.199 -Nil for never, t for everytime, and 'ask for inquiring
   1.200 -at each reserved chars.")
   1.201 -
   1.202  ;
   1.203  ; Subject: [yatex:02849] Re: [yahtml] tilda in href tag
   1.204  ; From: Masayasu Ishikawa <mimasa@sfc.keio.ac.jp>
   1.205 @@ -1096,6 +1155,7 @@
   1.206  	  width height bytes depth comment
   1.207  	  (file-coding-system-alist (list (cons "." 'no-conversion))) ;20
   1.208  	  (file-coding-system-for-read (and (boundp '*noconv*) *noconv*)) ;19
   1.209 +	  (coding-system-for-read 'no-conversion)
   1.210  	  (seekpoint 1)
   1.211  	  c1 c2 c3 c4 beg end
   1.212  	  (case-fold-search nil))
   1.213 @@ -1506,10 +1566,11 @@
   1.214  		  (if (string-match "/$" file)
   1.215  		      (or (catch 'dirindex
   1.216  			    (mapcar
   1.217 -			     (lambda (f)
   1.218 -			       (if (file-exists-p (concat file f))
   1.219 -				   (throw 'dirindex
   1.220 -					  (setq file (concat file f)))))
   1.221 +			     (function
   1.222 +			      (lambda (f)
   1.223 +				(if (file-exists-p (concat file f))
   1.224 +				    (throw 'dirindex
   1.225 +					   (setq file (concat file f))))))
   1.226  			     (yahtml-get-directory-index)))
   1.227  			  (setq file (concat file yahtml-directory-index))))
   1.228  		  (if (string-match "^/" file)
   1.229 @@ -1888,23 +1949,22 @@
   1.230    ))
   1.231  
   1.232  ;;; ---------- commenting ----------
   1.233 -(defvar yahtml-translate-hyphens-when-comment-region t
   1.234 -  "*Non-nil for translate hyphens to &#45; when comment-region")
   1.235  
   1.236  (defun yahtml-comment-region (&optional uncom)
   1.237    "Comment out region or environment."
   1.238    (interactive)
   1.239 -  (let ((e (make-marker)) beg p)
   1.240 +  (let ((e (make-marker)) be beg p)
   1.241      (cond
   1.242 -     ((marker-position (set-marker e (yahtml-on-begend-p)))
   1.243 +     (;(marker-position (set-marker e (yahtml-on-begend-p)))
   1.244 +      (setq be (yahtml-on-begend-p))
   1.245        (save-excursion
   1.246  	(setq p (point))
   1.247 -	(if (string-match "^/" e)
   1.248 +	(if (string-match "^/" be)
   1.249  	    (setq beg (progn (forward-line 1) (point)))
   1.250  	  (setq beg (progn (beginning-of-line) (point))))
   1.251  	(goto-char p)
   1.252  	(yahtml-goto-corresponding-begend)
   1.253 -	(if (string-match "^/" e)
   1.254 +	(if (string-match "^/" be)
   1.255  	    (beginning-of-line)
   1.256  	  (forward-line 1))
   1.257  	(set-marker e (point))
   1.258 @@ -2216,6 +2276,9 @@
   1.259       ((string-match "r" c)
   1.260        (yahtml-browse-reload)))))
   1.261  
   1.262 +(if (fboundp 'wrap-function-to-control-ime)
   1.263 +    (wrap-function-to-control-ime 'yahtml-browse-menu t nil))
   1.264 +
   1.265  (defvar yahtml-lint-buffer "*weblint*")
   1.266  
   1.267  (defun yahtml-lint-buffer (buf)
   1.268 @@ -2327,7 +2390,6 @@
   1.269        (if (string-match yahtml-p-prefered-env-regexp env)
   1.270  	  (yahtml-insert-p)))))
   1.271  
   1.272 -(defvar yahtml-faithful-to-htmllint nil)
   1.273  (defun yahtml-intelligent-newline-ul ()
   1.274    (interactive)
   1.275    (yahtml-insert-single "li")
   1.276 @@ -2409,9 +2471,6 @@
   1.277  
   1.278  
   1.279  ;;; ---------- jump to error line ----------
   1.280 -(defvar yahtml-error-line-regexp
   1.281 -  "^\\(.*\\)(\\([0-9]+\\)):"
   1.282 -  "*Regexp of error position which is produced by lint program.")
   1.283  (defun yahtml-prev-error ()
   1.284    "Jump to previous error seeing lint buffer."
   1.285    (interactive)
   1.286 @@ -2425,8 +2484,11 @@
   1.287    (let ((p (point)) (e (point-end-of-line)))
   1.288      (end-of-line)
   1.289      (if (re-search-backward yahtml-error-line-regexp nil t)
   1.290 -	(let ((f (YaTeX-match-string 1))
   1.291 -	      (l (string-to-int (YaTeX-match-string 2))))
   1.292 +	(let ((f (if (string= "" (YaTeX-match-string 1))
   1.293 +		     YaTeX-current-file-name
   1.294 +		   (YaTeX-match-string 1)))
   1.295 +	      (l (string-to-int (or (YaTeX-match-string 2)
   1.296 +				    (YaTeX-match-string 3)))))
   1.297  	  (if sit (sit-for 1))
   1.298  	  (forward-line -1)
   1.299  	  (YaTeX-showup-buffer (YaTeX-switch-to-buffer f t) nil t)
   1.300 @@ -2481,8 +2543,10 @@
   1.301    (save-excursion
   1.302      (goto-char (point-min))
   1.303      (set (make-local-variable 'yahtml-css-class-alist) nil)
   1.304 -    (while (re-search-forward "<\\(style\\|link\\)" nil t)
   1.305 -      (let ((b (match-beginning 0))(tag (YaTeX-match-string 1)) e href alist)
   1.306 +    (let (b tag type e href alist)
   1.307 +      (while (re-search-forward "<\\(style\\|link\\)" nil t)
   1.308 +	(setq b (match-beginning 0)
   1.309 +	      tag (YaTeX-match-string 1))
   1.310  	(cond
   1.311  	 ((string-match "style" tag)
   1.312  	  (goto-char b)
   1.313 @@ -2494,6 +2558,8 @@
   1.314  		   (point) (progn (search-forward "</style>") (point))
   1.315  		   alist)))))
   1.316  	 ((and (string-match "link" tag)
   1.317 +	       (stringp (setq type (yahtml-get-attrvalue "type")))
   1.318 +	       (string-match "text/css" type)
   1.319  	       (setq href (yahtml-get-attrvalue "href"))
   1.320  	       (file-exists-p (yahtml-url-to-path href)))
   1.321  	    (setq alist
   1.322 @@ -2525,21 +2591,26 @@
   1.323      ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\)" "-->" include)
   1.324      ;; string
   1.325      (hilit-string-find ?\\ string)
   1.326 -    (yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
   1.327 +    (yahtml-hilit-region-tag "<\\(em\\|strong\\|b\\)\\>" bold)
   1.328      ("</?[uod]l>" 0 decl)
   1.329      ("<\\(di\\|dt\\|li\\|dd\\)>" 0 label)
   1.330 -    ("<a\\s +href" "</a>" crossref)
   1.331 +    (yahtml-hilit-region-tag "<\\(i\\>\\)" italic)
   1.332 +    ;("<a\\s +href" "</a>" crossref) ;good for hilit19, but odd for font-lock..
   1.333 +    (yahtml-hilit-region-tag "<\\(a\\)\\s +href" crossref)
   1.334      (yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
   1.335      ))
   1.336  
   1.337  (defun yahtml-hilit-region-tag (tag)
   1.338    "Return list of start/end point of <TAG> form."
   1.339 -  (if (re-search-forward (concat "<" tag ">") nil t)
   1.340 -      (let ((m0 (match-beginning 0)))
   1.341 -	(skip-chars-forward " \t\n")
   1.342 -	(cons (point)
   1.343 -	      (progn (re-search-forward (concat "</" tag ">") nil t)
   1.344 -		     (match-beginning 0))))))
   1.345 +  (if (re-search-forward tag nil t)
   1.346 +      (let ((m0 (match-beginning 0)) (e0 (match-end 0))
   1.347 +	    (elm (YaTeX-match-string 1)))
   1.348 +	(skip-chars-forward "^>")
   1.349 +	(prog1
   1.350 +	    (cons (1+ (point))
   1.351 +		  (progn (re-search-forward (concat "</" elm ">") nil t)
   1.352 +			 (match-beginning 0)))
   1.353 +	  (goto-char e0)))))
   1.354  
   1.355  (defun yahtml-hilit-region-tag-itself (ptn)
   1.356    "Return list of start/end point of <tag options...> itself."
   1.357 @@ -2554,6 +2625,57 @@
   1.358  	 (setq hilit-patterns-alist
   1.359  	       (cons (cons 'yahtml-mode yahtml-hilit-patterns-alist)
   1.360  		     hilit-patterns-alist))))
   1.361 +;;;
   1.362 +;; for font-lock
   1.363 +;;;
   1.364 +
   1.365 +; <<STATIC KEYWORDS BELOW NOT USED>>
   1.366 +;(defvar yahtml-font-lock-keywords
   1.367 +;  '(
   1.368 +;    ;; comments
   1.369 +;    ("<!--\\s .* -->" . font-lock-comment-face)
   1.370 +;    ;; include&exec
   1.371 +;    ("<!--#\\(include\\|exec\\|config\\|fsize\\|flastmod\\).*-->"
   1.372 +;     0 font-lock-include-face keep)
   1.373 +;    ;; string
   1.374 +;    ;(hilit-string-find ?\\ string)
   1.375 +;    ;(yahtml-hilit-region-tag "\\(em\\|strong\\)" bold)
   1.376 +;    ("</?[uod]l>" 0 font-lock-keyword-face)
   1.377 +;    ("<\\(di\\|dt\\|li\\|dd\\)>" 0 font-lock-label-face)
   1.378 +;    ("<a\\s +href=.*</a>" (0 font-lock-crossref-face keep))
   1.379 +;    ;(yahtml-hilit-region-tag-itself "</?\\sw+\\>" decl)
   1.380 +;    ("</?\\sw+\\>" (yahtml-fontify-to-tagend nil nil))
   1.381 +;    )
   1.382 +;  "*Defualt font-lock-keywords for yahtml-mode.")
   1.383 +(defvar yahtml-font-lock-keywords
   1.384 +  (YaTeX-convert-pattern-hilit2fontlock yahtml-hilit-patterns-alist)
   1.385 +  "Default fontifying patterns for yahtml-mode")
   1.386 +
   1.387 +(defun yahtml-font-lock-set-default-keywords ()
   1.388 +  (put 'yahtml-mode 'font-lock-defaults
   1.389 +       '(yahtml-font-lock-keywords nil t)))
   1.390 +
   1.391 +(if yahtml-use-font-lock
   1.392 +    (progn
   1.393 +      (if (and (boundp 'hilit-mode-enable-list) hilit-mode-enable-list)
   1.394 +	  ;;for those who use both hilit19 and font-lock
   1.395 +	  (if (eq (car hilit-mode-enable-list) 'not)
   1.396 +	      (or (member 'yahtml-mode hilit-mode-enable-list)
   1.397 +		  (nconc hilit-mode-enable-list (list 'yahtml-mode)))
   1.398 +	    (setq hilit-mode-enable-list
   1.399 +		  (delq 'yahtml-mode hilit-mode-enable-list))))
   1.400 +      (yahtml-font-lock-set-default-keywords)))
   1.401 +
   1.402 +;; (defun yahtml-fontify-to-tagend (lim)
   1.403 +;;   "*Fontify any tag including < and >.
   1.404 +;; This is invalid use of font-lock function.  Therefore
   1.405 +;; this fontifying will loose effectiveness soon or later."
   1.406 +;;   (let ((start (match-beginning 0))
   1.407 +;; 	(end (progn (skip-chars-forward "^>") (1+ (point)))))
   1.408 +;;     (or nil; (font-lock-any-faces-p start end)
   1.409 +;; 	(font-lock-fillin-text-property
   1.410 +;; 	 start end 'face 'font-lock font-lock-keyword-face)))
   1.411 +;;   nil)
   1.412  
   1.413  (run-hooks 'yahtml-load-hook)
   1.414  (provide 'yahtml)
   1.415 @@ -2562,4 +2684,5 @@
   1.416  ; fill-prefix: ";;; "
   1.417  ; paragraph-start: "^$\\|\\|;;;$"
   1.418  ; paragraph-separate: "^$\\|\\|;;;$"
   1.419 +; buffer-file-coding-system: sjis
   1.420  ; End: