yatex

diff yatexlib.el @ 73:f41b01fef5d6

Stable version(hope to be)
author yuuji
date Wed, 22 May 2002 04:57:42 +0000
parents 0aaebd07dad0
children 1b172d26b55e
line diff
     1.1 --- a/yatexlib.el	Mon Dec 25 10:19:28 2000 +0000
     1.2 +++ b/yatexlib.el	Wed May 22 04:57:42 2002 +0000
     1.3 @@ -1,8 +1,8 @@
     1.4  ;;; -*- Emacs-Lisp -*-
     1.5  ;;; YaTeX and yahtml common libraries, general functions and definitions
     1.6  ;;; yatexlib.el
     1.7 -;;; (c )1994-2000 by HIROSE Yuuji.[yuuji@yatex.org]
     1.8 -;;; Last modified Mon Dec 25 18:51:11 2000 on firestorm
     1.9 +;;; (c )1994-2002 by HIROSE Yuuji.[yuuji@yatex.org]
    1.10 +;;; Last modified Wed May 22 13:55:31 2002 on firestorm
    1.11  ;;; $Id$
    1.12  
    1.13  ;; General variables
    1.14 @@ -755,6 +755,28 @@
    1.15  	(setq str nil)))
    1.16      (nreverse list)))
    1.17  
    1.18 +;;;###autoload
    1.19 +(defun YaTeX-delete1 (elt list)
    1.20 +  "Delete"
    1.21 +  (let (e)
    1.22 +    (while (setq e (YaTeX-member elt list))
    1.23 +      (setq list (delq (car e) list))))
    1.24 +  list)
    1.25 +(if (fboundp 'delete)
    1.26 +    (fset 'YaTeX-delete (symbol-function 'delete))
    1.27 +  (fset 'YaTeX-delete (symbol-function 'YaTeX-delete1)))
    1.28 +
    1.29 +(defun YaTeX-member1 (elt list)
    1.30 +  (catch 'found
    1.31 +    (while list
    1.32 +      (if (equal elt (car list))
    1.33 +          (throw 'found list))
    1.34 +      (setq list (cdr list)))))
    1.35 +
    1.36 +(if (and (fboundp 'member) (subrp (symbol-function 'member)))
    1.37 +    (fset 'YaTeX-member (symbol-function 'member))
    1.38 +  (fset 'YaTeX-member (symbol-function 'YaTeX-member1)))
    1.39 +
    1.40  ;;;
    1.41  ;; Interface function for windows.el
    1.42  ;;;
    1.43 @@ -783,6 +805,8 @@
    1.44  recent sectioning command.  Matching point is stored to property 'point
    1.45  of 'YaTeX-inner-environment, which can be referred by
    1.46   (get 'YaTeX-inner-environment 'point)."
    1.47 +  (put 'YaTeX-inner-environment 'point (point-min))
    1.48 +  (put 'YaTeX-inner-environment 'indent 0)
    1.49    (let*((nest 0)
    1.50  	(beg (YaTeX-replace-format-args
    1.51  	      (regexp-quote YaTeX-struct-begin)
    1.52 @@ -807,7 +831,8 @@
    1.53  		(save-excursion
    1.54  		  (if htmlp 
    1.55  		      ;;(re-search-backward YaTeX-sectioning-regexp nil 1)
    1.56 -		      (goto-char (point-min)) ;Is this enough? 97/6/26
    1.57 +		      ;;(goto-char (point-min)) ;Is this enough? 97/6/26
    1.58 +		      (re-search-backward yahtml-indentation-boundary nil 1)
    1.59  		    (YaTeX-re-search-active-backward
    1.60  		     (concat YaTeX-ec-regexp
    1.61  			     "\\(" YaTeX-sectioning-regexp "\\)\\*?{")
    1.62 @@ -832,6 +857,82 @@
    1.63  	   (progn (skip-chars-forward open) (1+ (point)))
    1.64  	   (progn (skip-chars-forward close) (point)))))))
    1.65  
    1.66 +(defun YaTeX-goto-corresponding-environment (&optional allow-mismatch noerr)
    1.67 +  "Go to corresponding begin/end enclosure.
    1.68 +Optional argument ALLOW-MISMATCH allows mismatch open/clese.  Use this
    1.69 +for \left(, \right).
    1.70 +Optional third argument NOERR causes no error for unballanced environment."
    1.71 +  (interactive)
    1.72 +  (if (not (YaTeX-on-begin-end-p)) nil
    1.73 +    (let ((p  (match-end 0)) b0 b1 env (nest 0) regexp re-s (op (point))
    1.74 +	  (m0 (match-beginning 0))	;whole matching
    1.75 +	  (m1 (match-beginning 1))	;environment in \begin{}
    1.76 +	  (m2 (match-beginning 2))	;environment in \end{}
    1.77 +	  (m3 (match-beginning 3)))	;environment in \[ \] \( \)
    1.78 +      ;(setq env (regexp-quote (buffer-substring p (match-beginning 0))))
    1.79 +      (if (cond
    1.80 +	   (m1				;if begin{xxx}
    1.81 +	    (setq env
    1.82 +		  (if allow-mismatch YaTeX-struct-name-regexp
    1.83 +		    (regexp-quote (buffer-substring m1 (match-end 1)))))
    1.84 +	;    (setq regexp (concat "\\(\\\\end{" env "}\\)\\|"
    1.85 +	;			 "\\(\\\\begin{" env "}\\)"))
    1.86 +	    (setq regexp
    1.87 +		  (concat
    1.88 +		   "\\("
    1.89 +		   (YaTeX-replace-format-args
    1.90 +		    (regexp-quote YaTeX-struct-end) env "" "")
    1.91 +		   "\\)\\|\\("
    1.92 +		   (YaTeX-replace-format-args
    1.93 +		    (regexp-quote YaTeX-struct-begin) env "" "")
    1.94 +		   "\\)"))
    1.95 +	    (setq re-s 're-search-forward))
    1.96 +	   (m2				;if end{xxx}
    1.97 +	    (setq env
    1.98 +		  (if allow-mismatch YaTeX-struct-name-regexp
    1.99 +		    (regexp-quote (buffer-substring m2 (match-end 2)))))
   1.100 +	;   (setq regexp (concat "\\(\\\\begin{" env "}\\)\\|"
   1.101 +	;			 "\\(\\\\end{" env "}\\)"))
   1.102 +	    (setq regexp
   1.103 +		  (concat
   1.104 +		   "\\("
   1.105 +		   (YaTeX-replace-format-args
   1.106 +		    (regexp-quote YaTeX-struct-begin) env "" "")
   1.107 +		   "\\)\\|\\("
   1.108 +		   (YaTeX-replace-format-args
   1.109 +		    (regexp-quote YaTeX-struct-end) env "" "")
   1.110 +		   "\\)"))
   1.111 +	    (setq re-s 're-search-backward))
   1.112 +	   (m3				;math environment
   1.113 +	    (setq env (char-after (1+ m3))
   1.114 +		  regexp (format "\\(%s%s\\)\\|\\(%s%s\\)"
   1.115 +				 YaTeX-ec-regexp
   1.116 +				 (regexp-quote
   1.117 +				  (cdr (assq env '((?( . ")") (?) . "(")
   1.118 +						   (?[ . "]") (?] . "[")))))
   1.119 +				 YaTeX-ec-regexp
   1.120 +				 (regexp-quote (char-to-string env)))
   1.121 +		  re-s (if (memq env '(?\( ?\[))
   1.122 +			   're-search-forward
   1.123 +			 're-search-backward)))
   1.124 +	   (t (if noerr nil (error "Corresponding environment not found."))))
   1.125 +	  (progn
   1.126 +	    (while (and (>= nest 0) (funcall re-s regexp nil t))
   1.127 +	      (setq b0 (match-beginning 0) b1 (match-beginning 1))
   1.128 +	      (if (or (equal b0 m0)
   1.129 +		      (YaTeX-literal-p b0))
   1.130 +		  nil
   1.131 +		(setq nest (if (equal b0 b1)
   1.132 +			       (1- nest) (1+ nest)))))
   1.133 +	    (if (< nest 0)
   1.134 +		(goto-char (match-beginning 0)) ;found.
   1.135 +	      (goto-char op)
   1.136 +	      (funcall
   1.137 +	       (if noerr 'message 'error)
   1.138 +	       "Corresponding environment `%s' not found." env)
   1.139 +	      (sit-for 1)
   1.140 +	      nil))))))
   1.141 +
   1.142  (defun YaTeX-end-environment ()
   1.143    "Close opening environment"
   1.144    (interactive)
   1.145 @@ -994,7 +1095,8 @@
   1.146  	(mapping
   1.147  	 '((bold . YaTeX-font-lock-bold-face)
   1.148  	   (italic . YaTeX-font-lock-italic-face)
   1.149 -	   (define . font-lock-function-name-face)
   1.150 +	   (defun . font-lock-function-name-face)
   1.151 +	   (define . font-lock-variable-name-face)
   1.152  	   (keyword . font-lock-keyword-face)
   1.153  	   (decl . YaTeX-font-lock-declaration-face)
   1.154  	   (label . YaTeX-font-lock-label-face)
   1.155 @@ -1014,7 +1116,7 @@
   1.156  	       (if (numberp (car (cdr i)))
   1.157  		   (list (car i)	;regexp
   1.158  			 (car (cdr i))	;matching group number
   1.159 -			 newface t) ;'keep)	;keep is hilit19 taste
   1.160 +			 newface nil) ;'keep)	;keep is hilit19 taste
   1.161  		 (list
   1.162  		  (concat
   1.163  		   (car i)		;original regexp and..
   1.164 @@ -1023,7 +1125,7 @@
   1.165  		   ;;"]+" ;for shortest match
   1.166  		   ".*"
   1.167  		   (car (cdr i)))
   1.168 -		  0 (list 'quote newface) t)) ;;'keep))
   1.169 +		  0 (list 'quote newface) nil)) ;;'keep))
   1.170  	       flpa)))
   1.171         ((and (symbolp (car i)) (fboundp (car i)))
   1.172  	(setq flpa
   1.173 @@ -1034,7 +1136,7 @@
   1.174  		       'lambda (list 'dummy)
   1.175  		       '(goto-char (match-beginning 0))
   1.176  		       '(remove-text-properties
   1.177 -			 (point) (1+ (point))
   1.178 +			 (point) (min (point-max) (1+ (point)))
   1.179  			 '(face nil font-lock-multiline nil))
   1.180  		       (list
   1.181  			'let (list '(e (match-end 0))
   1.182 @@ -1058,8 +1160,12 @@
   1.183  	(nreverse flpa)
   1.184        flpa)))
   1.185  
   1.186 +(if (and (boundp 'YaTeX-use-font-lock)
   1.187 +	 YaTeX-use-font-lock)
   1.188 +    (require 'font-lock))
   1.189 +
   1.190  (cond
   1.191 - ((featurep 'font-lock)
   1.192 + ((and (featurep 'font-lock) (fboundp 'defface))
   1.193    ;; In each defface, '(class static-color) is for Emacs-21 -nw
   1.194    ;; '(class tty) is for XEmacs-21 -nw
   1.195    (defface YaTeX-font-lock-label-face
   1.196 @@ -1121,14 +1227,26 @@
   1.197    ;; Make sure the 'YaTeX-font-lock-{italic,bold}-face is bound with
   1.198    ;; italic/bold fontsets
   1.199    (if (and (fboundp 'fontset-list) YaTeX-use-italic-bold)
   1.200 -      (let ((flist (fontset-list)) fnt italic bold)
   1.201 +      (let ((flist (fontset-list)) fnt italic bold
   1.202 +	    (df (or (and (fboundp 'face-font-name) (face-font-name 'default))
   1.203 +		    (face-font 'default)
   1.204 +		    (face-font 'italic)
   1.205 +		    (face-font 'bold)
   1.206 +		    "giveup!"))
   1.207 +	    sz medium-i bold-r)
   1.208 +	(string-match
   1.209 +	 "^-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-\\(\\([0-9]+\\)\\)" df)
   1.210 +	(setq sz (or (match-string 1 df) "16"))
   1.211 +	(setq medium-i (format "-medium-i-[^-]+--%s" sz)
   1.212 +	      bold-r (format "-bold-r-[^-]+--%s" sz))
   1.213  	(while flist
   1.214  	  (setq fnt (car flist))
   1.215  	  (condition-case err
   1.216  	      (cond
   1.217 -	       ((and (string-match "-medium-i-" fnt) (null italic))
   1.218 +	       ((and (string-match medium-i fnt)
   1.219 +		     (null italic))
   1.220  		(set-face-font 'YaTeX-font-lock-italic-face (setq italic fnt)))
   1.221 -	       ((and (string-match "-bold-r-" fnt) (null bold))
   1.222 +	       ((and (string-match bold-r fnt) (null bold))
   1.223  		(set-face-font 'YaTeX-font-lock-bold-face (setq bold fnt))))
   1.224  	    (error nil))
   1.225  	  (setq flist (cdr flist)))))