1.1 --- a/yatexlib.el	Thu Dec 25 04:10:32 2003 +0000
     1.2 +++ b/yatexlib.el	Sun Dec 24 06:16:52 2006 +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-2002 by HIROSE Yuuji.[yuuji@yatex.org]
     1.8 -;;; Last modified Tue Aug 19 22:20:40 2003 on firestorm
     1.9 +;;; (c)1994-2006 by HIROSE Yuuji.[yuuji@yatex.org]
    1.10 +;;; Last modified Sun Dec 24 15:12:20 2006 on firestorm
    1.11  ;;; $Id$
    1.12  
    1.13  ;; General variables
    1.14 @@ -32,6 +32,10 @@
    1.15  ;; autoload from yahtml.el
    1.16  (autoload 'yahtml-inner-environment-but "yahtml" "yahtml internal func." t)
    1.17  
    1.18 +(defvar latex-message-kanji-code 2
    1.19 +  "*Kanji coding system latex command types out.
    1.20 +1 = Shift JIS, 2 = JIS, 3 = EUC. 4 = UTF-8")
    1.21 +
    1.22  (defvar YaTeX-kanji-code-alist
    1.23    (cond
    1.24     ((boundp '*junet*)
    1.25 @@ -43,7 +47,7 @@
    1.26  	    (YaTeX-macos (if (boundp '*sjis-mac*) *sjis-mac* *sjis*mac))
    1.27  	    (t *sjis*)))
    1.28  	  '(2 . *junet*) '(3 . *euc-japan*)))
    1.29 -   (YaTeX-emacs-20
    1.30 +   ((and YaTeX-emacs-20 (featurep 'mule))
    1.31      ;;(cdr-safe(assq 'coding-system (assoc "Japanese" language-info-alist)))
    1.32      (list '(0 . no-conversion)
    1.33  	  (cons
    1.34 @@ -52,7 +56,8 @@
    1.35  		   ((member 'shift_jis (coding-system-list)) 'shift_jis-unix)
    1.36  		   (t 'sjis)))
    1.37  	  '(2 . iso-2022-jp-unix)
    1.38 -	  '(3 . euc-jp-unix))))
    1.39 +	  '(3 . euc-jp-unix)
    1.40 +	  '(4 . utf-8))))
    1.41    "Kanji-code expression translation table.")
    1.42  (defvar YaTeX-inhibit-prefix-letter nil
    1.43    "*T for changing key definitions from [prefix] Letter to [prefix] C-Letter.")
    1.44 @@ -79,6 +84,16 @@
    1.45  \it, \bf 内部での日本語が□になってしまう場合はこれをnilにして下さい。")
    1.46  
    1.47  ;----------- work variables ----------------------------------------
    1.48 +(defvar YaTeX-minibuffer-completion-map nil
    1.49 +  "Minibuffer completion key map that allows comma completion.")
    1.50 +(if YaTeX-minibuffer-completion-map nil
    1.51 +  (setq YaTeX-minibuffer-completion-map
    1.52 +	(copy-keymap minibuffer-local-completion-map))
    1.53 +  (define-key YaTeX-minibuffer-completion-map " "
    1.54 +    'YaTeX-minibuffer-complete)
    1.55 +  (define-key YaTeX-minibuffer-completion-map "\t"
    1.56 +    'YaTeX-minibuffer-complete))
    1.57 +
    1.58  (defvar YaTeX-typesetting-mode-map nil
    1.59    "Keymap used in YaTeX typesetting buffer")
    1.60  
    1.61 @@ -127,6 +142,7 @@
    1.62  ;;;###autoload
    1.63  (defun YaTeX-read-user-completion-table (&optional forcetoread)
    1.64    "Append user completion table of LaTeX macros"
    1.65 +  (interactive)
    1.66    (let*((user-table (expand-file-name YaTeX-user-completion-table))
    1.67  	(local-table (expand-file-name (file-name-nondirectory user-table)))
    1.68  	var localvar localbuf (curbuf (current-buffer)) sexp)
    1.69 @@ -140,7 +156,7 @@
    1.70        (set-buffer (setq localbuf (find-file-noselect local-table)))
    1.71        (widen)
    1.72        (goto-char (point-min))
    1.73 -      (while (re-search-forward "(setq \\([^ ]+\\)" nil t)
    1.74 +      (while (re-search-forward "(setq \\([^ \t\n]+\\)" nil t)
    1.75  	(setq var (intern (buffer-substring
    1.76  			   (match-beginning 1) (match-end 1)))
    1.77  	      localvar (YaTeX-local-table-symbol var))
    1.78 @@ -340,6 +356,13 @@
    1.79    (YaTeX-search-active-forward
    1.80     regexp cmntrx bound err cnt 're-search-backward))
    1.81  
    1.82 +(defun YaTeX-relative-path-p (path)
    1.83 +  "Return non-nil if PATH is not absolute one."
    1.84 +  (let ((md (match-data)))
    1.85 +    (unwind-protect
    1.86 +	(not (string-match "^\\(/\\|[a-z]:\\|\\\\\\).*/" file))
    1.87 +      (store-match-data md))))
    1.88 +
    1.89  ;;;###autoload
    1.90  (defun YaTeX-switch-to-buffer (file &optional setbuf)
    1.91    "Switch to buffer if buffer exists, find file if not.
    1.92 @@ -347,7 +370,7 @@
    1.93    (interactive "Fswitch to file: ")
    1.94    (if (bufferp file)
    1.95        (setq file (buffer-file-name file))
    1.96 -    (and (string-match "^[^/].*/" file)
    1.97 +    (and (YaTeX-relative-path-p file)
    1.98  	 (eq major-mode 'yatex-mode)
    1.99  	 YaTeX-search-file-from-top-directory
   1.100  	 (save-excursion
   1.101 @@ -373,7 +396,7 @@
   1.102    (interactive "Fswitch to file: ")
   1.103    (and (eq major-mode 'yatex-mode)
   1.104         (stringp file)
   1.105 -       (string-match "^[^/].*/" file)
   1.106 +       (YaTeX-relative-path-p file)
   1.107         YaTeX-search-file-from-top-directory
   1.108         (save-excursion
   1.109  	 (YaTeX-visit-main t)
   1.110 @@ -412,7 +435,7 @@
   1.111  (defun YaTeX-replace-format (string format repl)
   1.112    "In STRING, replace first appearance of FORMAT to REPL as if
   1.113  function `format' does.  FORMAT does not contain `%'"
   1.114 -  (let ((ans string))
   1.115 +  (let ((ans string) (case-fold-search nil))
   1.116      (while (not (string=
   1.117  		 ans (setq string (YaTeX-replace-format-sub ans format repl))))
   1.118        (setq ans string))
   1.119 @@ -569,7 +592,7 @@
   1.120  (defun YaTeX-match-string (n &optional m)
   1.121    "Return (buffer-substring (match-beginning n) (match-beginning m))."
   1.122    (if (match-beginning n)
   1.123 -      (buffer-substring (match-beginning n)
   1.124 +      (YaTeX-buffer-substring (match-beginning n)
   1.125  			(match-end (or m n)))))
   1.126  
   1.127  ;;;###autoload
   1.128 @@ -979,7 +1002,7 @@
   1.129  	  (goto-char (get 'YaTeX-inner-environment 'point))
   1.130  	  (and end (YaTeX-goto-corresponding-environment))
   1.131  	  (if (interactive-p) (push-mark op))
   1.132 -	  t))))
   1.133 +	  (point)))))
   1.134  
   1.135  (defun YaTeX-end-of-environment (&optional limit-search-bound)
   1.136    "Goto the end of the current environment.
   1.137 @@ -993,8 +1016,10 @@
   1.138    (interactive)
   1.139    (let ((curp (point)))
   1.140      (if (and (YaTeX-on-begin-end-p) (match-beginning 1)) ;if on \\begin
   1.141 -	(forward-line 1)
   1.142 -      (beginning-of-line))
   1.143 +	(progn (goto-char (match-end 0)))
   1.144 +      (if (= (char-after (point)) ?\\) nil	;if on \\end
   1.145 +	(skip-chars-backward "^\n\\\\")
   1.146 +	(or (bolp) (forward-char -1))))
   1.147      (if (not (YaTeX-end-of-environment))   ;arg1 turns to match-beginning 1
   1.148  	(progn
   1.149  	  (goto-char curp)
   1.150 @@ -1033,6 +1058,17 @@
   1.151      (insert (YaTeX-replace-format-args YaTeX-struct-end env)))
   1.152     (t nil)))
   1.153  
   1.154 +(defun YaTeX-string-width (str)
   1.155 +  "Return the display width of string."
   1.156 +  (if (fboundp 'string-width)
   1.157 +      (string-width str)
   1.158 +    (length str)))
   1.159 +(defun YaTeX-truncate-string-width (str width)
   1.160 +  (cond
   1.161 +   ((fboundp 'truncate-string-to-width) (truncate-string-to-width str width))
   1.162 +   ((fboundp 'truncate-string) (truncate-string str width))
   1.163 +   (t (substring str 0 width))))
   1.164 +
   1.165  ;;; Function for menu support
   1.166  (defun YaTeX-define-menu (keymap bindlist)
   1.167    "Define KEYMAP(symbol)'s menu-bindings according to BINDLIST.
   1.168 @@ -1093,9 +1129,17 @@
   1.169    (if (eq (selected-window) (minibuffer-window))
   1.170        (if (fboundp 'delete-field) (delete-field) (erase-buffer))))
   1.171  
   1.172 +(fset 'YaTeX-buffer-substring
   1.173 +      (if (fboundp 'buffer-substring-no-properties)
   1.174 +	  'buffer-substring-no-properties
   1.175 +	'buffer-substring))
   1.176 +
   1.177  ;;;
   1.178  ;; hilit19 vs. font-lock
   1.179  ;;;
   1.180 +(defvar YaTeX-19-functions-font-lock-direct
   1.181 +  '(YaTeX-19-re-search-in-env))
   1.182 +
   1.183  (defun YaTeX-convert-pattern-hilit2fontlock (h19pa)
   1.184    "Convert hilit19's H19PA patterns alist to font-lock's one.
   1.185  This function is a makeshift for YaTeX and yahtml."
   1.186 @@ -1113,6 +1157,7 @@
   1.187  	   (crossref . YaTeX-font-lock-crossref-face)
   1.188  	   (include . YaTeX-font-lock-include-face)
   1.189  	   (formula . YaTeX-font-lock-formula-face)
   1.190 +	   (delimiter . YaTeX-font-lock-delimiter-face)
   1.191  	   (string . ignore) (comment . ignore)
   1.192  	   )))
   1.193      (while (setq i (car palist))
   1.194 @@ -1138,33 +1183,45 @@
   1.195  		  0 (list 'quote newface) nil)) ;;'keep))
   1.196  	       flpa)))
   1.197         ((and (symbolp (car i)) (fboundp (car i)))
   1.198 -	(setq flpa
   1.199 -	      (cons
   1.200 -	       (list (car (cdr i))	;regexp
   1.201 -		     (list
   1.202 -		      (list
   1.203 -		       'lambda (list 'dummy)
   1.204 -		       '(goto-char (match-beginning 0))
   1.205 -		       '(remove-text-properties
   1.206 -			 (point) (min (point-max) (1+ (point)))
   1.207 -			 '(face nil font-lock-multiline nil))
   1.208 +	(if (memq (car i) YaTeX-19-functions-font-lock-direct)
   1.209 +	    ;; Put direct function call for it.
   1.210 +	    ;; When calling this function, fontify entire matched string.
   1.211 +	    (setq flpa
   1.212 +		  (cons
   1.213 +		   (list
   1.214 +		    (list 'lambda (list 'dummy) ;dummy should be boundary
   1.215 +			  (list (car i) (list 'quote (car (cdr i)))))
   1.216 +		    (list 0 newface))
   1.217 +		   flpa))
   1.218 +	  (setq flpa
   1.219 +		(cons
   1.220 +		 (list (car (cdr i))	;regexp
   1.221  		       (list
   1.222 -			'let (list '(e (match-end 0))
   1.223 -				   (list 'm (list (car i) (car (cdr i)))))
   1.224  			(list
   1.225 -			 'if 'm
   1.226 +			 'lambda (list 'dummy)
   1.227 +			 '(goto-char (match-beginning 0))
   1.228 +			 (if (eq (nth 3 i) 'overwrite)
   1.229 +			     nil
   1.230 +			   '(remove-text-properties
   1.231 +			     (point) (min (point-max) (1+ (point)))
   1.232 +			     '(face nil font-lock-multiline nil)))
   1.233  			 (list
   1.234 -			  'YaTeX-font-lock-fillin
   1.235 -			  (list 'car 'm)
   1.236 -			  (list 'cdr 'm)
   1.237 -			  (list 'quote 'face)
   1.238 -			  (list 'quote 'font-lock)
   1.239 -			  (list 'quote newface))
   1.240 -			 '(goto-char e)
   1.241 -			 ))
   1.242 -		       nil)		;retun nil to cheat font-lock
   1.243 -		      nil nil))		;pre-match, post-match both nil
   1.244 -	       flpa))))
   1.245 +			  'let (list '(e (match-end 0))
   1.246 +				     (list 'm (list (car i) (car (cdr i)))))
   1.247 +			  (list
   1.248 +			   'if 'm
   1.249 +			   (list
   1.250 +			    'YaTeX-font-lock-fillin
   1.251 +			    (list 'car 'm)
   1.252 +			    (list 'cdr 'm)
   1.253 +			    (list 'quote 'face)
   1.254 +			    (list 'quote 'font-lock)
   1.255 +			    (list 'quote newface))
   1.256 +			   '(goto-char e)
   1.257 +			   ))
   1.258 +			 nil)		;retun nil to cheat font-lock
   1.259 +			nil nil))	;pre-match, post-match both nil
   1.260 +		 flpa)))))
   1.261        (setq palist (cdr palist)));while
   1.262      (if (featurep 'xemacsp)
   1.263  	(nreverse flpa)
   1.264 @@ -1214,11 +1271,46 @@
   1.265      :group 'font-lock-faces)
   1.266    (defvar YaTeX-font-lock-formula-face 'YaTeX-font-lock-formula-face)
   1.267  
   1.268 +  (defface YaTeX-font-lock-delimiter-face
   1.269 +    '((((class static-color)) (:bold t))
   1.270 +      (((type tty)) (:bold t))
   1.271 +      (((class color) (background dark))
   1.272 +       (:foreground "saddlebrown" :background "ivory" :bold t))
   1.273 +      (((class color) (background light)) (:foreground "red"))
   1.274 +      (t (:bold t :underline t)))
   1.275 +    "Font Lock mode face used to highlight delimiters."
   1.276 +    :group 'font-lock-faces)
   1.277 +  (defvar YaTeX-font-lock-delimiter-face 'YaTeX-font-lock-delimiter-face)
   1.278 +
   1.279 +  (defface YaTeX-font-lock-math-sub-face
   1.280 +    '((((class static-color)) (:bold t))
   1.281 +      (((type tty)) (:bold t))
   1.282 +      (((class color) (background dark))
   1.283 +       (:foreground "khaki" :bold t :underline t))
   1.284 +      (((class color) (background light))
   1.285 +       (:foreground "Goldenrod" :underline t))
   1.286 +      (t (:bold t :underline t)))
   1.287 +    "Font Lock mode face used to highlight subscripts in formula."
   1.288 +    :group 'font-lock-faces)
   1.289 +  (defvar YaTeX-font-lock-math-sub-face 'YaTeX-font-lock-math-sub-face)
   1.290 +
   1.291 +  (defface YaTeX-font-lock-math-sup-face
   1.292 +    '((((class static-color)) (:bold t))
   1.293 +      (((type tty)) (:bold t))
   1.294 +      (((class color) (background dark))
   1.295 +       (:bold nil :foreground "ivory" :background "lightyellow4"))
   1.296 +      (((class color) (background light))
   1.297 +       (:underline t :foreground "gold"))
   1.298 +      (t (:bold t :underline t)))
   1.299 +    "Font Lock mode face used to highlight superscripts in formula."
   1.300 +    :group 'font-lock-faces)
   1.301 +  (defvar YaTeX-font-lock-math-sup-face 'YaTeX-font-lock-math-sup-face)
   1.302 +
   1.303    (defface YaTeX-font-lock-crossref-face
   1.304      '((((class color) (background dark)) (:foreground "lightgoldenrod"))
   1.305        (((class color) (background light)) (:foreground "DarkGoldenrod"))
   1.306        (t (:bold t :underline t)))
   1.307 -    "Font Lock mode face used to highlight cress references."
   1.308 +    "Font Lock mode face used to highlight cross references."
   1.309      :group 'font-lock-faces)
   1.310    (defvar YaTeX-font-lock-crossref-face 'YaTeX-font-lock-crossref-face)
   1.311  
   1.312 @@ -1300,6 +1392,17 @@
   1.313        (select-window sw)))
   1.314    ))
   1.315  
   1.316 +(defun YaTeX-assoc-regexp (elt alist)
   1.317 +  "Like assoc, return a list of whose car match with ELT.  Search from ALIST.
   1.318 +Note that each car of cons-cell is regexp.  ELT is a plain text to be
   1.319 +compared by regexp."
   1.320 +  (let (x)
   1.321 +    (catch 'found
   1.322 +      (while alist
   1.323 +	(setq x (car (car alist)))
   1.324 +	(if (string-match x elt)
   1.325 +	    (throw 'found (car alist)))
   1.326 +	(setq alist (cdr alist))))))
   1.327  
   1.328  ;;;
   1.329  ;; Functions for the Installation time
   1.330 @@ -1315,10 +1418,25 @@
   1.331  	(mapcar 'byte-compile-file command-line-args-left)
   1.332  	(kill-emacs))))
   1.333  
   1.334 +(defun tfb-and-exit ()
   1.335 +  "Texinfo-format-buffer and kill-emacs."
   1.336 +  (if command-line-args-left
   1.337 +      (let ((load-path (cons ".." load-path)))
   1.338 +	(and (fboundp 'set-language-environment)
   1.339 +	     (featurep 'mule)
   1.340 +	     (set-language-environment "Japanese"))
   1.341 +	(mapcar (function
   1.342 +		 (lambda (arg)
   1.343 +		   (find-file arg)
   1.344 +		   (texinfo-format-buffer)
   1.345 +		   (basic-save-buffer)))
   1.346 +		command-line-args-left)
   1.347 +	(kill-emacs))))
   1.348 +
   1.349  (provide 'yatexlib)
   1.350  ; Local variables:
   1.351  ; fill-prefix: ";;; "
   1.352  ; paragraph-start: "^$\\|\\|;;;$"
   1.353  ; paragraph-separate: "^$\\|\\|;;;$"
   1.354 -; buffer-file-coding-system: sjis
   1.355 +; coding: sjis
   1.356  ; End: