1.1 --- a/yatexlib.el	Sun Apr 09 03:37:47 2000 +0000
     1.2 +++ b/yatexlib.el	Mon Dec 25 10:19:28 2000 +0000
     1.3 @@ -2,17 +2,25 @@
     1.4  ;;; YaTeX and yahtml common libraries, general functions and definitions
     1.5  ;;; yatexlib.el
     1.6  ;;; (c )1994-2000 by HIROSE Yuuji.[yuuji@yatex.org]
     1.7 -;;; Last modified Sun Apr  9 12:36:25 2000 on firestorm
     1.8 +;;; Last modified Mon Dec 25 18:51:11 2000 on firestorm
     1.9  ;;; $Id$
    1.10  
    1.11  ;; General variables
    1.12  (defvar YaTeX-dos (memq system-type '(ms-dos windows-nt OS/2)))
    1.13  (defvar YaTeX-emacs-19 (>= (string-to-int emacs-version) 19))
    1.14  (defvar YaTeX-emacs-20 (>= (string-to-int emacs-version) 20))
    1.15 +(defvar YaTeX-emacs-21 (>= (string-to-int emacs-version) 21))
    1.16  (defvar YaTeX-user-completion-table
    1.17    (if YaTeX-dos "~/_yatexrc" "~/.yatexrc")
    1.18    "*Default filename in which user completion table is saved.")
    1.19  
    1.20 +(defvar YaTeX-display-color-p
    1.21 +  (or (and (fboundp 'display-color-p) (display-color-p))
    1.22 +      (and (fboundp 'device-class)
    1.23 +	   (eq 'color (device-class (selected-device))))
    1.24 +      window-system)  ; falls down lazy check..
    1.25 +  "Current display's capability of expressing colors.")
    1.26 +
    1.27  (defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)
    1.28    "Whether yatex mode is running on Japanese environment or not.")
    1.29  
    1.30 @@ -55,6 +63,11 @@
    1.31    "*If you are nervous about maintenance of yatexrc, set this value to T.
    1.32  And you will have the local dictionary.")
    1.33  
    1.34 +(defvar YaTeX-use-italic-bold (string< "20" emacs-version)
    1.35 +  "*Non-nil tries to find italic/bold fontset.
    1.36 +This variable is effective when font-lock is used.
    1.37 +\it, \bf 内部での日本語が□になってしまう場合はこれをnilにして下さい。")
    1.38 +
    1.39  ;----------- work variables ----------------------------------------
    1.40  (defvar YaTeX-typesetting-mode-map nil
    1.41    "Keymap used in YaTeX typesetting buffer")
    1.42 @@ -295,6 +308,7 @@
    1.43  		 (and (eq major-mode 'yatex-mode)
    1.44  		      (YaTeX-in-verb-p (match-beginning 0)))
    1.45  		 (save-excursion
    1.46 +		   (goto-char (match-beginning 0))
    1.47  		   (beginning-of-line)
    1.48  		   (re-search-forward cmntrx (match-beginning 0) t)))))
    1.49      (store-match-data md)
    1.50 @@ -517,6 +531,19 @@
    1.51  	  (setq wlist (cons win wlist))))
    1.52      wlist))
    1.53  
    1.54 +(if YaTeX-emacs-21
    1.55 +    ;; Emacs-21's next-window returns other frame's window even if called
    1.56 +    ;; with argument ALL-FRAMES nil, when called from minibuffer context.
    1.57 +    ;; Therefore, check frame identity here.
    1.58 +    (defun YaTeX-window-list ()
    1.59 +      (let*((curw (selected-window)) (win curw) (wlist (list curw))
    1.60 +	    (curf (window-frame curw)))
    1.61 +	(while (and (not (eq curw (setq win (next-window win))))
    1.62 +		    (eq curf (window-frame win)))
    1.63 +	  (or (eq win (minibuffer-window))
    1.64 +	      (setq wlist (cons win wlist))))
    1.65 +	wlist)))
    1.66 +
    1.67  ;;;###autoload
    1.68  (defun substitute-all-key-definition (olddef newdef keymap)
    1.69    "Replace recursively OLDDEF with NEWDEF for any keys in KEYMAP now
    1.70 @@ -544,53 +571,57 @@
    1.71    If the symbol 'quick is bound and is 't, when the try-completion results
    1.72  in t, exit minibuffer immediately."
    1.73    (interactive)
    1.74 -  (let ((md (match-data)) beg word compl
    1.75 -	(quick (and (boundp 'quick) (eq quick t)))
    1.76 -	(displist			;function to display completion-list
    1.77 -	 (function
    1.78 -	  (lambda ()
    1.79 -	    (with-output-to-temp-buffer "*Completions*"
    1.80 -	      (display-completion-list
    1.81 -	       (all-completions word minibuffer-completion-table)))))))
    1.82 -    (setq beg (if (and (boundp 'delim) (stringp delim))
    1.83 -		  (save-excursion
    1.84 -		    (skip-chars-backward (concat "^" delim))
    1.85 -		    (point))
    1.86 -		(point-min))
    1.87 -	  word (buffer-substring beg (point-max))
    1.88 -	  compl (try-completion word minibuffer-completion-table))
    1.89 -    (cond
    1.90 -     ((eq compl t)
    1.91 -      (if quick (exit-minibuffer)
    1.92 -	(let ((p (point)) (max (point-max)))
    1.93 -	  (unwind-protect
    1.94 -	      (progn
    1.95 -		(goto-char max)
    1.96 -		(insert " [Sole completion]")
    1.97 -		(goto-char p)
    1.98 -		(sit-for 1))
    1.99 -	    (delete-region max (point-max))
   1.100 -	    (goto-char p)))))
   1.101 -     ((eq compl nil)
   1.102 -      (ding)
   1.103 -      (save-excursion
   1.104 -	(let (p)
   1.105 -	  (unwind-protect
   1.106 -	      (progn
   1.107 -		(goto-char (setq p (point-max)))
   1.108 -		(insert " [No match]")
   1.109 -		(goto-char p)
   1.110 -		(sit-for 2))
   1.111 -	    (delete-region p (point-max))))))
   1.112 -     ((string= compl word)
   1.113 -      (funcall displist))
   1.114 -     (t (delete-region beg (point-max))
   1.115 -	(insert compl)
   1.116 -	(if quick
   1.117 -	    (if (eq (try-completion compl minibuffer-completion-table) t)
   1.118 -		(exit-minibuffer)
   1.119 -	      (funcall displist)))))
   1.120 -    (store-match-data md)))
   1.121 +  (save-restriction
   1.122 +    (narrow-to-region
   1.123 +     (if (fboundp 'field-beginning) (field-beginning (point-max)) (point-min))
   1.124 +     (point-max))
   1.125 +    (let ((md (match-data)) beg word compl
   1.126 +	  (quick (and (boundp 'quick) (eq quick t)))
   1.127 +	  (displist ;function to display completion-list
   1.128 +	   (function
   1.129 +	    (lambda ()
   1.130 +	      (with-output-to-temp-buffer "*Completions*"
   1.131 +		(display-completion-list
   1.132 +		 (all-completions word minibuffer-completion-table)))))))
   1.133 +      (setq beg (if (and (boundp 'delim) (stringp delim))
   1.134 +		    (save-excursion
   1.135 +		      (skip-chars-backward (concat "^" delim))
   1.136 +		      (point))
   1.137 +		  (point-min))
   1.138 +	    word (buffer-substring beg (point-max))
   1.139 +	    compl (try-completion word minibuffer-completion-table))
   1.140 +      (cond
   1.141 +       ((eq compl t)
   1.142 +	(if quick (exit-minibuffer)
   1.143 +	  (let ((p (point)) (max (point-max)))
   1.144 +	    (unwind-protect
   1.145 +		(progn
   1.146 +		  (goto-char max)
   1.147 +		  (insert " [Sole completion]")
   1.148 +		  (goto-char p)
   1.149 +		  (sit-for 1))
   1.150 +	      (delete-region max (point-max))
   1.151 +	      (goto-char p)))))
   1.152 +       ((eq compl nil)
   1.153 +	(ding)
   1.154 +	(save-excursion
   1.155 +	  (let (p)
   1.156 +	    (unwind-protect
   1.157 +		(progn
   1.158 +		  (goto-char (setq p (point-max)))
   1.159 +		  (insert " [No match]")
   1.160 +		  (goto-char p)
   1.161 +		  (sit-for 2))
   1.162 +	      (delete-region p (point-max))))))
   1.163 +       ((string= compl word)
   1.164 +	(funcall displist))
   1.165 +       (t (delete-region beg (point-max))
   1.166 +	  (insert compl)
   1.167 +	  (if quick
   1.168 +	      (if (eq (try-completion compl minibuffer-completion-table) t)
   1.169 +		  (exit-minibuffer)
   1.170 +		(funcall displist)))))
   1.171 +      (store-match-data md))))
   1.172  
   1.173  (defun YaTeX-minibuffer-quick-complete ()
   1.174    "Set 'quick to 't and call YaTeX-minibuffer-complete.
   1.175 @@ -691,12 +722,12 @@
   1.176  
   1.177  (defun YaTeX-insert-file-contents (file visit &optional beg end)
   1.178    (cond
   1.179 -   ((string< "19" emacs-version)
   1.180 +   ((and (string< "19" emacs-version) (not (featurep 'xemacs)))
   1.181      (insert-file-contents file visit beg end))
   1.182     ((string-match "unix" (symbol-name system-type))
   1.183      (let ((default-process-coding-system
   1.184 -	    (and (boundp '*noconv*) (list *noconv*)))
   1.185 -	  file-coding-system (and (boundp '*noconv*) *noconv*)
   1.186 +	    (and (boundp '*noconv*) (list '*noconv*)))
   1.187 +	  (file-coding-system (and (boundp '*noconv*) '*noconv*))
   1.188  	  kanji-fileio-code
   1.189  	  (default-process-kanji-code 0))
   1.190        (call-process shell-file-name file (current-buffer) nil
   1.191 @@ -870,6 +901,16 @@
   1.192        (end-of-line)
   1.193        (if (eobp) nil (forward-char 1)))))
   1.194  
   1.195 +(defun YaTeX-kill-buffer (buffer)
   1.196 +  "Make effort to show parent buffer after kill."
   1.197 +  (interactive "bKill buffer: ")
   1.198 +  (or (get-buffer buffer)
   1.199 +      (error "No such buffer %s" buffer))
   1.200 +  (let ((pf YaTeX-parent-file))
   1.201 +    (kill-buffer buffer)
   1.202 +    (and pf
   1.203 +	 (get-file-buffer pf)
   1.204 +	 (switch-to-buffer (get-file-buffer pf)))))
   1.205  
   1.206  ;;;VER2
   1.207  (defun YaTeX-insert-struc (what env)
   1.208 @@ -921,6 +962,216 @@
   1.209  	(define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
   1.210       bindlist))))
   1.211  
   1.212 +;;;
   1.213 +;; Emacs 21 compensational wrapper
   1.214 +;;;
   1.215 +(defun YaTeX-minibuffer-begin ()
   1.216 + (if (fboundp 'field-beginning)
   1.217 +     (field-beginning (point-max))
   1.218 +   (point-min)))
   1.219 +
   1.220 +(defun YaTeX-minibuffer-end ()
   1.221 + (if (fboundp 'field-end)
   1.222 +     (field-end (point-max))
   1.223 +   (point-max)))
   1.224 +
   1.225 +(defun YaTeX-minibuffer-string ()
   1.226 +  (buffer-substring (YaTeX-minibuffer-begin) (YaTeX-minibuffer-end)))
   1.227 +
   1.228 +(defun YaTeX-minibuffer-erase ()
   1.229 +  (if (eq (selected-window) (minibuffer-window))
   1.230 +      (if (fboundp 'delete-field) (delete-field) (erase-buffer))))
   1.231 +
   1.232 +;;;
   1.233 +;; hilit19 vs. font-lock
   1.234 +;;;
   1.235 +(defun YaTeX-convert-pattern-hilit2fontlock (h19pa)
   1.236 +  "Convert hilit19's H19PA patterns alist to font-lock's one.
   1.237 +This function is a makeshift for YaTeX and yahtml."
   1.238 +  (let ((ignorecase (not (null (car h19pa))))
   1.239 +	(palist (cdr h19pa))
   1.240 +	flpa i newface
   1.241 +	(mapping
   1.242 +	 '((bold . YaTeX-font-lock-bold-face)
   1.243 +	   (italic . YaTeX-font-lock-italic-face)
   1.244 +	   (define . font-lock-function-name-face)
   1.245 +	   (keyword . font-lock-keyword-face)
   1.246 +	   (decl . YaTeX-font-lock-declaration-face)
   1.247 +	   (label . YaTeX-font-lock-label-face)
   1.248 +	   (crossref . YaTeX-font-lock-crossref-face)
   1.249 +	   (include . YaTeX-font-lock-include-face)
   1.250 +	   (formula . YaTeX-font-lock-formula-face)
   1.251 +	   (string . ignore) (comment . ignore)
   1.252 +	   )))
   1.253 +    (while (setq i (car palist))
   1.254 +      (setq newface (nth 2 i)
   1.255 +	    newface (or (cdr (assq newface mapping)) newface))
   1.256 +      (cond
   1.257 +       ((eq newface 'ignore) nil)	;no translation
   1.258 +       ((stringp (car i))		;hiliting by regexp
   1.259 +	(setq flpa
   1.260 +	      (cons
   1.261 +	       (if (numberp (car (cdr i)))
   1.262 +		   (list (car i)	;regexp
   1.263 +			 (car (cdr i))	;matching group number
   1.264 +			 newface t) ;'keep)	;keep is hilit19 taste
   1.265 +		 (list
   1.266 +		  (concat
   1.267 +		   (car i)		;original regexp and..
   1.268 +		   ;;"[^"
   1.269 +		   ;;(regexp-quote (substring (car (cdr i)) 0 1))
   1.270 +		   ;;"]+" ;for shortest match
   1.271 +		   ".*"
   1.272 +		   (car (cdr i)))
   1.273 +		  0 (list 'quote newface) t)) ;;'keep))
   1.274 +	       flpa)))
   1.275 +       ((and (symbolp (car i)) (fboundp (car i)))
   1.276 +	(setq flpa
   1.277 +	      (cons
   1.278 +	       (list (car (cdr i))	;regexp
   1.279 +		     (list
   1.280 +		      (list
   1.281 +		       'lambda (list 'dummy)
   1.282 +		       '(goto-char (match-beginning 0))
   1.283 +		       '(remove-text-properties
   1.284 +			 (point) (1+ (point))
   1.285 +			 '(face nil font-lock-multiline nil))
   1.286 +		       (list
   1.287 +			'let (list '(e (match-end 0))
   1.288 +				   (list 'm (list (car i) (car (cdr i)))))
   1.289 +			(list
   1.290 +			 'if 'm
   1.291 +			 (list
   1.292 +			  'YaTeX-font-lock-fillin
   1.293 +			  (list 'car 'm)
   1.294 +			  (list 'cdr 'm)
   1.295 +			  (list 'quote 'face)
   1.296 +			  (list 'quote 'font-lock)
   1.297 +			  (list 'quote newface))
   1.298 +			 '(goto-char e)
   1.299 +			 ))
   1.300 +		       nil)		;retun nil to cheat font-lock
   1.301 +		      nil nil))		;pre-match, post-match both nil
   1.302 +	       flpa))))
   1.303 +      (setq palist (cdr palist)));while
   1.304 +    (if (featurep 'xemacsp)
   1.305 +	(nreverse flpa)
   1.306 +      flpa)))
   1.307 +
   1.308 +(cond
   1.309 + ((featurep 'font-lock)
   1.310 +  ;; In each defface, '(class static-color) is for Emacs-21 -nw
   1.311 +  ;; '(class tty) is for XEmacs-21 -nw
   1.312 +  (defface YaTeX-font-lock-label-face
   1.313 +    '((((class static-color)) (:foreground "yellow" :underline t))
   1.314 +      (((type tty)) (:foreground "yellow" :underline t))
   1.315 +      (((class color) (background dark)) (:foreground "pink" :underline t))
   1.316 +      (((class color) (background light)) (:foreground "red" :underline t))
   1.317 +      (t (:bold t :underline t)))
   1.318 +    "Font Lock mode face used to highlight labels."
   1.319 +    :group 'font-lock-faces)
   1.320 +  (defvar YaTeX-font-lock-label-face 'YaTeX-font-lock-label-face)
   1.321 +
   1.322 +  (defface YaTeX-font-lock-declaration-face
   1.323 +    '((((class color) (background dark)) (:foreground "cyan"))
   1.324 +      (((class color) (background light)) (:foreground "RoyalBlue"))
   1.325 +      (t (:bold t :underline t)))
   1.326 +    "Font Lock mode face used to highlight some declarations."
   1.327 +    :group 'font-lock-faces)
   1.328 +  (defvar YaTeX-font-lock-declaration-face 'YaTeX-font-lock-declaration-face)
   1.329 +
   1.330 +  (defface YaTeX-font-lock-include-face
   1.331 +    '((((class color) (background dark)) (:foreground "Plum1"))
   1.332 +      (((class color) (background light)) (:foreground "purple"))
   1.333 +      (t (:bold t :underline t)))
   1.334 +    "Font Lock mode face used to highlight expression for including."
   1.335 +    :group 'font-lock-faces)
   1.336 +  (defvar YaTeX-font-lock-include-face 'YaTeX-font-lock-include-face)
   1.337 +
   1.338 +  (defface YaTeX-font-lock-formula-face
   1.339 +    '((((class static-color)) (:bold t))
   1.340 +      (((type tty)) (:bold t))
   1.341 +      (((class color) (background dark)) (:foreground "khaki" :bold t))
   1.342 +      (((class color) (background light)) (:foreground "Goldenrod"))
   1.343 +      (t (:bold t :underline t)))
   1.344 +    "Font Lock mode face used to highlight formula."
   1.345 +    :group 'font-lock-faces)
   1.346 +  (defvar YaTeX-font-lock-formula-face 'YaTeX-font-lock-formula-face)
   1.347 +
   1.348 +  (defface YaTeX-font-lock-crossref-face
   1.349 +    '((((class color) (background dark)) (:foreground "lightgoldenrod"))
   1.350 +      (((class color) (background light)) (:foreground "DarkGoldenrod"))
   1.351 +      (t (:bold t :underline t)))
   1.352 +    "Font Lock mode face used to highlight cress references."
   1.353 +    :group 'font-lock-faces)
   1.354 +  (defvar YaTeX-font-lock-crossref-face 'YaTeX-font-lock-crossref-face)
   1.355 +
   1.356 +  (defface YaTeX-font-lock-bold-face
   1.357 +    '((t (:bold t)))
   1.358 +    "Font Lock mode face used to express bold itself."
   1.359 +    :group 'font-lock-faces)
   1.360 +  (defvar YaTeX-font-lock-bold-face 'YaTeX-font-lock-bold-face)
   1.361 +
   1.362 +  (defface YaTeX-font-lock-italic-face
   1.363 +    '((t (:italic t)))
   1.364 +    "Font Lock mode face used to express italic itself."
   1.365 +    :group 'font-lock-faces)
   1.366 +  (defvar YaTeX-font-lock-italic-face 'YaTeX-font-lock-italic-face)
   1.367 +
   1.368 +  ;; Make sure the 'YaTeX-font-lock-{italic,bold}-face is bound with
   1.369 +  ;; italic/bold fontsets
   1.370 +  (if (and (fboundp 'fontset-list) YaTeX-use-italic-bold)
   1.371 +      (let ((flist (fontset-list)) fnt italic bold)
   1.372 +	(while flist
   1.373 +	  (setq fnt (car flist))
   1.374 +	  (condition-case err
   1.375 +	      (cond
   1.376 +	       ((and (string-match "-medium-i-" fnt) (null italic))
   1.377 +		(set-face-font 'YaTeX-font-lock-italic-face (setq italic fnt)))
   1.378 +	       ((and (string-match "-bold-r-" fnt) (null bold))
   1.379 +		(set-face-font 'YaTeX-font-lock-bold-face (setq bold fnt))))
   1.380 +	    (error nil))
   1.381 +	  (setq flist (cdr flist)))))
   1.382 +
   1.383 +  ;;Borrowed from XEmacs's font-lock.el
   1.384 +  (defsubst YaTeX-font-lock-fillin (start end setprop markprop value &optional object)
   1.385 +    "Fill in one property of the text from START to END.
   1.386 +Arguments PROP and VALUE specify the property and value to put where none are
   1.387 +already in place.  Therefore existing property values are not overwritten.
   1.388 +Optional argument OBJECT is the string or buffer containing the text."
   1.389 +    (let ((start (text-property-any start end markprop nil object)) next
   1.390 +	  (putfunc (if (fboundp 'put-nonduplicable-text-property)
   1.391 +		       'put-nonduplicable-text-property
   1.392 +		     'put-text-property)))
   1.393 +      (if (eq putfunc 'put-text-property)
   1.394 +	  (setq markprop setprop))
   1.395 +      (while start
   1.396 +	(setq next (next-single-property-change start markprop object end))
   1.397 +	(funcall putfunc start next setprop value object)
   1.398 +	(funcall putfunc start next markprop value object)
   1.399 +	(setq start (text-property-any next end markprop nil object)))))
   1.400 +
   1.401 +  (defun YaTeX-warning-font-lock (mode)
   1.402 +    (let ((sw (selected-window)))
   1.403 +      ;;(pop-to-buffer (format " *%s warning*" mode))
   1.404 +      ;;(erase-buffer)
   1.405 +      (momentary-string-display
   1.406 +      (cond
   1.407 +       (YaTeX-japan
   1.408 +	(concat mode " は、既に font-lock に対応しました。\n"
   1.409 +		"~/.emacs などにある\n"
   1.410 +		"\t(put 'yatex-mode 'font-lock-keywords 'tex-mode)\n"
   1.411 +		"\t(put 'yahtml-mode 'font-lock-keywords 'html-mode)\n"
   1.412 +		"などの間に合わせの記述はもはや不要です。"))
   1.413 +       (t
   1.414 +	(concat mode " now supports the font-lock by itself.\n"
   1.415 +		"So you can remove the descriptions such as\n"
   1.416 +		"\t(put 'yatex-mode 'font-lock-keywords 'tex-mode)\n"
   1.417 +		"\t(put 'yahtml-mode 'font-lock-keywords 'html-mode)\n"
   1.418 +		"in your ~/.emacs file.  Thank you."))) (point))
   1.419 +      (select-window sw)))
   1.420 +  ))
   1.421 +
   1.422  
   1.423  ;;;
   1.424  ;; Functions for the Installation time
   1.425 @@ -937,3 +1188,9 @@
   1.426  	(kill-emacs))))
   1.427  
   1.428  (provide 'yatexlib)
   1.429 +; Local variables:
   1.430 +; fill-prefix: ";;; "
   1.431 +; paragraph-start: "^$\\|\\|;;;$"
   1.432 +; paragraph-separate: "^$\\|\\|;;;$"
   1.433 +; buffer-file-coding-system: sjis
   1.434 +; End: