1.1 --- a/yatex19.el	Thu Jun 29 13:46:57 1995 +0000
     1.2 +++ b/yatex19.el	Sat Dec 02 18:35:28 1995 +0000
     1.3 @@ -1,7 +1,7 @@
     1.4  ;;; -*- Emacs-Lisp -*-
     1.5  ;;; YaTeX facilities for Emacs 19
     1.6  ;;; (c )1994-1995 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp]
     1.7 -;;; Last modified Mon May 15 15:50:04 1995 on inspire
     1.8 +;;; Last modified Sun Dec  3 03:29:56 1995 on inspire
     1.9  ;;; $Id$
    1.10  
    1.11  ;;; とりあえず hilit19 を使っている時に色が付くようにして
    1.12 @@ -325,8 +325,13 @@
    1.13  (defvar YaTeX-hilit-pattern-adjustment-private nil
    1.14    "*Adjustment hilit-pattern-alist for default yatex-mode's pattern.")
    1.15  (defvar YaTeX-hilit-sectioning-face
    1.16 -  '(yellow/dodgerblue yellow/cornflowerblue)
    1.17 +  '(yellow/dodgerblue yellow/slateblue)
    1.18    "*Hilightening face for sectioning unit.  '(FaceForLight FaceForDark)")
    1.19 +(defvar YaTeX-hilit-sectioning-attenuation-rate
    1.20 +  '(15 40)
    1.21 +  "*Maximum attenuation rate of sectioning face. '(ForeRate BackRate)
    1.22 +Each rate specifies how much portion of RGB value should be attenuated
    1.23 +towards to lowest sectioning unit.  Numbers should be written in percentage.")
    1.24  (defvar YaTeX-sectioning-patterns-alist nil
    1.25    "Hilightening patterns for sectioning units.")
    1.26  (defvar YaTeX-hilit-singlecmd-face
    1.27 @@ -345,7 +350,9 @@
    1.28  	(sectcol (symbol-name sectface))
    1.29  	sect-pat-alist)
    1.30      (if (string-match "/" sectcol)
    1.31 -	(let (colorvalue fR fG fB bR bG bB list pat fg bg level from face)
    1.32 +	(let ((fmin (nth 0 YaTeX-hilit-sectioning-attenuation-rate))
    1.33 +	      (bmin (nth 1 YaTeX-hilit-sectioning-attenuation-rate))
    1.34 +	      colorvalue fR fG fB bR bG bB pat fg bg level from face list lm)
    1.35  	  (require 'yatexsec)
    1.36  	  (setq fg (substring sectcol 0 (string-match "/" sectcol))
    1.37  		bg (substring sectcol (1+ (string-match "/" sectcol)))
    1.38 @@ -357,18 +364,19 @@
    1.39  		bR (/ (nth 0 colorvalue) 256)
    1.40  		bG (/ (nth 1 colorvalue) 256)
    1.41  		bB (/ (nth 2 colorvalue) 256)
    1.42 +		lm YaTeX-sectioning-max-level
    1.43  		list YaTeX-sectioning-level)
    1.44  	  (while list
    1.45  	    (setq pat (concat YaTeX-ec-regexp (car (car list)) "\\*?{")
    1.46  		  level (cdr (car list))
    1.47  		  fg (format "hex-%02x%02x%02x"
    1.48 -			     (- fR (/ (* level fR) 40)) ;40 musn't be constant
    1.49 -			     (- fG (/ (* level fG) 40))
    1.50 -			     (- fB (/ (* level fB) 40)))
    1.51 +			     (- fR (/ (* level fR fmin) lm 100))
    1.52 +			     (- fG (/ (* level fG fmin) lm 100))
    1.53 +			     (- fB (/ (* level fB fmin) lm 100)))
    1.54  		  bg (format "hex-%02x%02x%02x"
    1.55 -			     (- bR (/ (* level bR) 15)) ;15 musn't be constant
    1.56 -			     (- bG (/ (* level bG) 15))
    1.57 -			     (- bB (/ (* level bB) 15)))
    1.58 +			     (- bR (/ (* level bR bmin) lm 100))
    1.59 +			     (- bG (/ (* level bG bmin) lm 100))
    1.60 +			     (- bB (/ (* level bB bmin) lm 100)))
    1.61  		  from (intern (format "sectioning-%d" level))
    1.62  		  face (intern (concat fg "/" bg)))
    1.63  	    (hilit-translate from face)
    1.64 @@ -390,39 +398,45 @@
    1.65  	      (cond
    1.66  	       ((eq hilit-background-mode 'light) (car table))
    1.67  	       ((eq hilit-background-mode 'dark) (car (cdr table)))
    1.68 -	       (t nil))))))
    1.69 +	       (t nil)))))
    1.70 +	  sect single)
    1.71        (hilit-translate
    1.72         ;;sectioning (funcall get-face YaTeX-hilit-sectioning-face)
    1.73 -       macro (funcall get-face YaTeX-hilit-singlecmd-face)))
    1.74 -    (setq hilit-patterns-alist		;Remove at first.
    1.75 -	  (delq 'yatex-mode hilit-patterns-alist)
    1.76 -	  hilit-patterns-alist
    1.77 -	  (cons
    1.78 -	   (cons 'yatex-mode
    1.79 -		 (append
    1.80 -		  YaTeX-sectioning-patterns-alist
    1.81 -		  YaTeX-hilit-pattern-adjustment-private
    1.82 -		  ;;YaTeX-hilit-pattern-adjustment-default
    1.83 -		  YaTeX-hilit-patterns-alist
    1.84 -		  (list
    1.85 -		   (list
    1.86 -		    'YaTeX-19-region-section-type
    1.87 -		    (concat "\\\\\\("
    1.88 -			    (mapconcat
    1.89 -			     (function (lambda (s) (regexp-quote (car s))))
    1.90 -			     (append user-section-table tmp-section-table)
    1.91 -			     "\\|")
    1.92 -			    "\\){")
    1.93 -		    'keyword)
    1.94 -		   (list
    1.95 -		    (concat "\\\\\\("
    1.96 -			    (mapconcat
    1.97 -			     (function (lambda (s) (regexp-quote (car s))))
    1.98 -			     (append user-singlecmd-table tmp-singlecmd-table)
    1.99 -			     "\\|")
   1.100 -			    "\\)\\b")
   1.101 -		    0 'macro))))
   1.102 -	   hilit-patterns-alist)))))
   1.103 +       macro (funcall get-face YaTeX-hilit-singlecmd-face))
   1.104 +      (if (setq sect (append user-section-table tmp-section-table))
   1.105 +	  (setq sect (concat "\\\\\\("
   1.106 +			     (mapconcat
   1.107 +			      (function
   1.108 +			       (lambda (s) (regexp-quote (car s))))
   1.109 +			      sect
   1.110 +			      "\\|")
   1.111 +			     "\\){")))
   1.112 +      (if (setq single (append user-singlecmd-table tmp-singlecmd-table))
   1.113 +	  (setq single (concat "\\\\\\("
   1.114 +			       (mapconcat
   1.115 +				(function (lambda (s) (regexp-quote (car s))))
   1.116 +				single
   1.117 +				"\\|")
   1.118 +			       "\\)\\b")))
   1.119 +      (setq hilit-patterns-alist		;Remove at first.
   1.120 +	    (delq (assq 'yatex-mode hilit-patterns-alist) hilit-patterns-alist)
   1.121 +	    hilit-patterns-alist
   1.122 +	    (cons
   1.123 +	     (cons 'yatex-mode
   1.124 +		   (append
   1.125 +		    (list nil)
   1.126 +		    YaTeX-sectioning-patterns-alist
   1.127 +		    YaTeX-hilit-pattern-adjustment-private
   1.128 +		    ;;YaTeX-hilit-pattern-adjustment-default
   1.129 +		    YaTeX-hilit-patterns-alist
   1.130 +		    (delq nil
   1.131 +			  (list
   1.132 +			   (if sect (list
   1.133 +				     'YaTeX-19-region-section-type
   1.134 +				     sect
   1.135 +				     'keyword))
   1.136 +			   (if single (list single 0 'macro))))))
   1.137 +	     hilit-patterns-alist))))))
   1.138  ;;(YaTeX-19-collect-macros)	;causes an error
   1.139  (defun YaTeX-hilit-recenter (arg)
   1.140    "Collect current local macro and hilit-recenter."
   1.141 @@ -490,5 +504,10 @@
   1.142  ;;;       string 'mediumspringgreen
   1.143  ;;;       formula 'khaki
   1.144  ;;;       label 'yellow-underlined))
   1.145 +(and YaTeX-emacs-19
   1.146 +     (eval-when-compile
   1.147 +       (if (and (boundp 'window-system) window-system)
   1.148 +	   (require 'hilit19)
   1.149 +	 (error "Byte compile this file on window system! Not `-nw'!"))))
   1.150  
   1.151  (provide 'yatex19)