yatex

view yatexlib.el @ 481:723f136edde5

Legacy local variable settings removed
author HIROSE Yuuji <yuuji@gentei.org>
date Sun, 10 Sep 2017 17:03:34 +0859
parents 2011de73a671
children 9132c20372ec
line source
1 ;;; yatexlib.el --- YaTeX and yahtml common libraries -*- coding: sjis -*-
2 ;;;
3 ;;; (c)1994-2017 by HIROSE Yuuji.[yuuji@yatex.org]
4 ;;; Last modified Sun Sep 10 09:53:33 2017 on firestorm
5 ;;; $Id$
7 ;;; Code:
9 ;; High-precedence compatible function
10 (fset 'YaTeX-str2int
11 (if (fboundp 'string-to-number)
12 (function
13 (lambda (string &optional base)
14 (ceiling (string-to-number string base))))
15 'string-to-int))
17 ;; General variables
18 (defvar YaTeX-dos (memq system-type '(ms-dos windows-nt OS/2)))
19 (defvar YaTeX-macos (memq system-type '(darwin)))
20 (defvar YaTeX-emacs-19 (>= (YaTeX-str2int emacs-version) 19))
21 (defvar YaTeX-emacs-20 (>= (YaTeX-str2int emacs-version) 20))
22 (defvar YaTeX-emacs-21 (>= (YaTeX-str2int emacs-version) 21))
23 (defvar YaTeX-user-completion-table
24 (if YaTeX-dos "~/_yatexrc" "~/.yatexrc")
25 "*Default filename in which user completion table is saved.")
27 (defvar YaTeX-display-color-p
28 (or (and (fboundp 'display-color-p) (display-color-p))
29 (and (fboundp 'device-class)
30 (eq 'color (device-class (selected-device))))
31 window-system) ; falls down lazy check..
32 "Current display's capability of expressing colors.")
34 (defvar YaTeX-japan
35 (or (boundp 'NEMACS)
36 (boundp 'MULE)
37 (and (boundp 'current-language-environment)
38 (string-match "[Jj]apanese" current-language-environment)))
39 "Whether yatex mode is running on Japanese environment or not.")
41 ;; autoload from yahtml.el
42 (autoload 'yahtml-inner-environment-but "yahtml" "yahtml internal func." t)
44 (defvar latex-message-kanji-code 2
45 "*Kanji coding system latex command types out.
46 1 = Shift JIS, 2 = JIS, 3 = EUC. 4 = UTF-8")
48 (defvar YaTeX-kanji-code-alist
49 (cond
50 ((boundp '*junet*)
51 (list '(0 . *noconv*)
52 (cons
53 1
54 (cond
55 (YaTeX-dos (if (boundp '*sjis-dos*) *sjis-dos* *sjis*dos))
56 (YaTeX-macos (if (boundp '*sjis-mac*) *sjis-mac* *sjis*mac))
57 (t *sjis*)))
58 '(2 . *junet*) '(3 . *euc-japan*)))
59 ((and YaTeX-emacs-20 (featurep 'mule))
60 ;;(cdr-safe(assq 'coding-system (assoc "Japanese" language-info-alist)))
61 (list '(0 . no-conversion)
62 (cons
63 1 (cond (YaTeX-dos 'shift_jis-dos)
64 (YaTeX-macos 'shift_jis-mac)
65 ((member 'shift_jis (coding-system-list)) 'shift_jis-unix)
66 (t 'sjis)))
67 '(2 . iso-2022-jp-unix)
68 '(3 . euc-jp-unix)
69 '(4 . utf-8))))
70 "Kanji-code expression translation table.")
71 (defvar YaTeX-inhibit-prefix-letter nil
72 "*T for changing key definitions from [prefix] Letter to [prefix] C-Letter.")
74 (defvar YaTeX-no-begend-shortcut nil
75 "*T for disabling shortcut of begin-type completion, [prefix] b d, etc.")
77 (defvar YaTeX-default-pop-window-height 10
78 "Default typesetting buffer height.
79 If integer, sets the window-height of typesetting buffer.
80 If string, sets the percentage of it.
81 If nil, use default pop-to-buffer.")
83 (defvar YaTeX-create-file-prefix-g nil
84 "*Non-nil creates new file when [prefix] g on \\include{foo}.")
86 (defvar YaTeX-nervous t
87 "*If you are nervous about maintenance of yatexrc, set this value to T.
88 And you will have the local dictionary.")
90 (defvar YaTeX-use-italic-bold (string< "20" emacs-version)
91 "*Non-nil tries to find italic/bold fontset.
92 This variable is effective when font-lock is used.
93 \it, \bf 内部での日本語が□になってしまう場合はこれをnilにして下さい。")
95 ;----------- work variables ----------------------------------------
96 (defvar YaTeX-minibuffer-completion-map nil
97 "Minibuffer completion key map that allows comma completion.")
98 (if YaTeX-minibuffer-completion-map nil
99 (setq YaTeX-minibuffer-completion-map
100 (copy-keymap minibuffer-local-completion-map))
101 (define-key YaTeX-minibuffer-completion-map " "
102 'YaTeX-minibuffer-complete)
103 (define-key YaTeX-minibuffer-completion-map "\t"
104 'YaTeX-minibuffer-complete))
106 (defvar YaTeX-typesetting-mode-map nil
107 "Keymap used in YaTeX typesetting buffer")
109 (if YaTeX-typesetting-mode-map nil
110 (setq YaTeX-typesetting-mode-map (make-keymap))
111 ;(suppress-keymap YaTeX-typesetting-mode-map t)
112 (define-key YaTeX-typesetting-mode-map " " 'YaTeX-jump-error-line)
113 (define-key YaTeX-typesetting-mode-map "\C-m" 'YaTeX-send-string)
114 (define-key YaTeX-typesetting-mode-map "1" 'delete-other-windows)
115 (define-key YaTeX-typesetting-mode-map "0" 'delete-window)
116 (define-key YaTeX-typesetting-mode-map "q" 'delete-window))
118 (defvar YaTeX-parent-file nil
119 "*Main LaTeX source file name used when %#! expression doesn't exist.")
120 (make-variable-buffer-local 'YaTeX-parent-file)
122 ;---------- Define default key bindings on YaTeX mode map ----------
123 ;;;###autoload
124 (defun YaTeX-define-key (key binding &optional map)
125 "Define key on YaTeX-prefix-map."
126 (if YaTeX-inhibit-prefix-letter
127 (let ((c (aref key 0)))
128 (cond
129 ((and (>= c ?a) (<= c ?z)) (aset key 0 (1+ (- c ?a))))
130 ((and (>= c ?A) (<= c ?Z) (numberp YaTeX-inhibit-prefix-letter))
131 (aset key 0 (1+ (- c ?A))))
132 (t nil))))
133 (define-key (or map YaTeX-prefix-map) key binding))
135 ;;;###autoload
136 (defun YaTeX-local-table-symbol (symbol)
137 "Return the lisp symbol which keeps local completion table of SYMBOL."
138 (intern (concat "YaTeX$"
139 default-directory
140 (symbol-name symbol))))
142 ;;;###autoload
143 (defun YaTeX-sync-local-table (symbol)
144 "Synchronize local variable SYMBOL.
145 Copy its corresponding directory dependent completion table to SYMBOL."
146 (if (boundp (YaTeX-local-table-symbol symbol))
147 (set symbol (symbol-value (YaTeX-local-table-symbol symbol)))))
149 (defvar YaTeX-user-table-is-read nil
150 "Flag that means whether user completion table has been read or not.")
151 ;;;###autoload
152 (defun YaTeX-read-user-completion-table (&optional forcetoread)
153 "Append user completion table of LaTeX macros"
154 (interactive)
155 (let*((user-table (expand-file-name YaTeX-user-completion-table))
156 (local-table (expand-file-name (file-name-nondirectory user-table)))
157 var localvar localbuf (curbuf (current-buffer)) sexp)
158 (if YaTeX-user-table-is-read nil
159 (message "Loading user completion table")
160 (if (file-exists-p user-table) (load-file user-table)
161 (message "Welcome to the field of YaTeX. I'm glad to see you!")))
162 (setq YaTeX-user-table-is-read t)
163 (cond
164 ((file-exists-p local-table)
165 (set-buffer (setq localbuf (find-file-noselect local-table)))
166 (widen)
167 (goto-char (point-min))
168 (while (re-search-forward "(setq \\([^ \t\n]+\\)" nil t)
169 (setq var (intern (buffer-substring
170 (match-beginning 1) (match-end 1)))
171 localvar (YaTeX-local-table-symbol var))
172 (goto-char (match-beginning 0))
173 (setq sexp (buffer-substring (point)
174 (progn (forward-sexp) (point))))
175 (set-buffer curbuf)
176 (or (assq var (buffer-local-variables)) (make-local-variable var))
177 (eval (read sexp))
178 (or (and (boundp localvar)
179 (symbol-value localvar)
180 (not forcetoread))
181 (set localvar (symbol-value var)))
182 (set-buffer localbuf))
183 (kill-buffer localbuf)))
184 (set-buffer curbuf)))
186 ;;;###autoload
187 (defun YaTeX-reload-dictionary ()
188 "Reload local dictionary.
189 Use this function after editing ./.yatexrc."
190 (interactive)
191 (let ((YaTeX-user-table-is-read nil))
192 (YaTeX-read-user-completion-table t)))
194 ;;;###autoload
195 (defun YaTeX-lookup-table (word type)
196 "Lookup WORD in completion table whose type is TYPE.
197 This function refers the symbol tmp-TYPE-table, user-TYPE-table, TYPE-table.
198 Typically, TYPE is one of 'env, 'section, 'fontsize, 'singlecmd."
199 (if (symbolp type) (setq type (symbol-name type)))
200 (or (assoc word (symbol-value (intern (concat "tmp-" type "-table"))))
201 (assoc word (symbol-value (intern (concat "user-" type "-table"))))
202 (assoc word (symbol-value (intern (concat type "-table"))))))
204 ;;;###autoload
205 (defun YaTeX-update-table (vallist default-table user-table local-table)
206 "Update completion table if the car of VALLIST is not in current tables.
207 Second argument DEFAULT-TABLE is the quoted symbol of default completion
208 table, third argument USER-TABLE is user table which will be saved in
209 YaTeX-user-completion-table, fourth argument LOCAL-TABLE should have the
210 completion which is valid during current Emacs's session. If you
211 want to make LOCAL-TABLE valid longer span (but restrict in this directory)
212 create the file in current directory which has the same name with
213 YaTeX-user-completion-table."
214 (let ((car-v (car vallist)) key answer
215 (file (file-name-nondirectory YaTeX-user-completion-table)))
216 (cond
217 ((assoc car-v (symbol-value default-table))
218 nil) ;Nothing to do
219 ((setq key (assoc car-v (symbol-value user-table)))
220 (if (equal (cdr vallist) (cdr key)) nil
221 ;; if association hits, but contents differ.
222 (message
223 "%s's attributes turned into %s" (car vallist) (cdr vallist))
224 (set user-table (delq key (symbol-value user-table)))
225 (set user-table (cons vallist (symbol-value user-table)))
226 (YaTeX-update-dictionary
227 YaTeX-user-completion-table user-table "user")))
228 ((setq key (assoc car-v (symbol-value local-table)))
229 (if (equal (cdr vallist) (cdr key)) nil
230 (message
231 "%s's attributes turned into %s" (car vallist) (cdr vallist))
232 (set local-table (delq key (symbol-value local-table)))
233 (set local-table (cons vallist (symbol-value local-table)))
234 (set (YaTeX-local-table-symbol local-table) (symbol-value local-table))
235 (YaTeX-update-dictionary file local-table)))
236 ;; All of above cases, there are some completion in tables.
237 ;; Then update tables.
238 (t
239 (if (not YaTeX-nervous)
240 (setq answer "u")
241 (message
242 (cond
243 (YaTeX-japan
244 "`%s'の登録先: U)ユーザ辞書 L)ローカル辞書 N)メモリ D)しない")
245 (t
246 "Register `%s' into: U)serDic L)ocalDic N)one D)iscard"))
247 (if (> (length car-v) 23)
248 (concat (substring car-v 0 10) "..." (substring car-v -9))
249 car-v))
250 (setq answer (char-to-string (read-char))))
251 (cond
252 ((string-match answer "uy")
253 (set user-table (cons vallist (symbol-value user-table)))
254 (YaTeX-update-dictionary YaTeX-user-completion-table user-table "user")
255 )
256 ((string-match answer "tl")
257 (set local-table (cons vallist (symbol-value local-table)))
258 (set (YaTeX-local-table-symbol local-table) (symbol-value local-table))
259 (YaTeX-update-dictionary file local-table))
260 ((string-match answer "d") nil) ;discard it
261 (t (set default-table
262 (cons vallist (symbol-value default-table)))))))))
264 ;;;###autoload
265 (defun YaTeX-cplread-with-learning
266 (prom default-table user-table local-table
267 &optional pred reqmatch init hsym)
268 "Completing read with learning.
269 Do a completing read with prompt PROM. Completion table is what
270 DEFAULT-TABLE, USER-TABLE, LOCAL table are appended in reverse order.
271 Note that these tables are passed by the symbol.
272 Optional arguments PRED, REQMATH and INIT are passed to completing-read
273 as its arguments PREDICATE, REQUIRE-MATCH and INITIAL-INPUT respectively.
274 If optional 8th argument HSYM, history symbol, is passed, use it as
275 history list variable."
276 (YaTeX-sync-local-table local-table)
277 (let*((table (append (symbol-value local-table)
278 (symbol-value user-table)
279 (symbol-value default-table)))
280 (word (completing-read-with-history
281 prom table pred reqmatch init hsym)))
282 (if (and (string< "" word) (not (assoc word table)))
283 (YaTeX-update-table (list word) default-table user-table local-table))
284 word))
286 ;;;###autoload
287 (defun YaTeX-update-dictionary (file symbol &optional type)
288 (let ((local-table-buf (find-file-noselect file))
289 (name (symbol-name symbol))
290 (value (symbol-value symbol)))
291 (save-excursion
292 (message "Updating %s dictionary..." (or type "local"))
293 (set-buffer local-table-buf)
294 (goto-char (point-max))
295 (search-backward (concat "(setq " name) nil t)
296 (delete-region (point) (progn (forward-sexp) (point)))
297 (delete-blank-lines)
298 (insert "(setq " name " '(\n")
299 (mapcar (function (lambda (s)
300 (insert (format "%s\n" (prin1-to-string s)))))
301 value)
302 (insert "))\n\n")
303 (delete-blank-lines)
304 (basic-save-buffer)
305 (kill-buffer local-table-buf)
306 (message "Updating %s dictionary...Done" (or type "local")))))
308 ;;;###autoload
309 (defun YaTeX-define-begend-key-normal (key env &optional map)
310 "Define short cut YaTeX-make-begin-end key."
311 (YaTeX-define-key
312 key
313 (list 'lambda '(arg) '(interactive "P")
314 (list 'YaTeX-insert-begin-end env 'arg))
315 map))
317 ;;;###autoload
318 (defun YaTeX-define-begend-region-key (key env &optional map)
319 "Define short cut YaTeX-make-begin-end-region key."
320 (YaTeX-define-key key (list 'lambda nil '(interactive)
321 (list 'YaTeX-insert-begin-end env t)) map))
323 ;;;###autoload
324 (defun YaTeX-define-begend-key (key env &optional map)
325 "Define short cut key for begin type completion.
326 Define both strokes for normal and region mode.
327 To customize YaTeX, user should use this function."
328 (YaTeX-define-begend-key-normal key env map)
329 (if YaTeX-inhibit-prefix-letter nil
330 (YaTeX-define-begend-region-key
331 (concat (upcase (substring key 0 1)) (substring key 1)) env)))
333 ;;;###autoload
334 (defun YaTeX-search-active-forward (string cmntrx &optional bound err cnt func)
335 "Search STRING which is not commented out by CMNTRX.
336 Optional arguments after BOUND, ERR, CNT are passed literally to search-forward
337 or search-backward.
338 Optional sixth argument FUNC changes search-function."
339 (let ((sfunc (or func 'search-forward)) found md)
340 (while (and (prog1
341 (setq found (funcall sfunc string bound err cnt))
342 (setq md (match-data)))
343 (or
344 (and (eq major-mode 'yatex-mode)
345 (YaTeX-in-verb-p (match-beginning 0)))
346 (save-excursion
347 (goto-char (match-beginning 0))
348 (beginning-of-line)
349 (re-search-forward cmntrx (match-beginning 0) t)))))
350 (store-match-data md)
351 found))
353 (defun YaTeX-re-search-active-forward (regexp cmntrx &optional bound err cnt)
354 "Search REGEXP backward which is not commented out by regexp CMNTRX.
355 See also YaTeX-search-active-forward."
356 (YaTeX-search-active-forward regexp cmntrx bound err cnt 're-search-forward))
358 (defun YaTeX-search-active-backward (string cmntrx &optional bound err cnt)
359 "Search STRING backward which is not commented out by regexp CMNTRX.
360 See also YaTeX-search-active-forward."
361 (YaTeX-search-active-forward string cmntrx bound err cnt 'search-backward))
363 (defun YaTeX-re-search-active-backward (regexp cmntrx &optional bound err cnt)
364 "Search REGEXP backward which is not commented out by regexp CMNTRX.
365 See also YaTeX-search-active-forward."
366 (YaTeX-search-active-forward
367 regexp cmntrx bound err cnt 're-search-backward))
369 (defun YaTeX-relative-path-p (path)
370 "Return non-nil if PATH is not absolute one."
371 (let ((md (match-data)))
372 (unwind-protect
373 (not (string-match "^\\(/\\|[a-z]:\\|\\\\\\).*/" file))
374 (store-match-data md))))
376 ;;;###autoload
377 (defun YaTeX-switch-to-buffer (file &optional setbuf)
378 "Switch to buffer if buffer exists, find file if not.
379 Optional second arg SETBUF t make use set-buffer instead of switch-to-buffer."
380 (interactive "Fswitch to file: ")
381 (if (bufferp file)
382 (setq file (buffer-file-name file))
383 (and (YaTeX-relative-path-p file)
384 (eq major-mode 'yatex-mode)
385 YaTeX-search-file-from-top-directory
386 (save-excursion
387 (YaTeX-visit-main t)
388 (setq file (expand-file-name file)))))
389 (let (buf (hilit-auto-highlight (not setbuf)))
390 (cond
391 ((setq buf (get-file-buffer file))
392 (funcall (if setbuf 'set-buffer 'switch-to-buffer)
393 (get-file-buffer file))
394 buf)
395 ((or YaTeX-create-file-prefix-g (file-exists-p file))
396 (or ;find-file returns nil but set current-buffer...
397 (if setbuf (set-buffer (find-file-noselect file))
398 (find-file file))
399 (current-buffer)))
400 (t (message "%s was not found in this directory." file)
401 nil))))
403 ;;;###autoload
404 (defun YaTeX-switch-to-buffer-other-window (file)
405 "Switch to buffer if buffer exists, find file if not."
406 (interactive "Fswitch to file: ")
407 (and (eq major-mode 'yatex-mode)
408 (stringp file)
409 (YaTeX-relative-path-p file)
410 YaTeX-search-file-from-top-directory
411 (save-excursion
412 (YaTeX-visit-main t)
413 (setq file (expand-file-name file))))
414 (if (bufferp file) (setq file (buffer-file-name file)))
415 (cond
416 ((get-file-buffer file)
417 (switch-to-buffer-other-window (get-file-buffer file))
418 t)
419 ((or YaTeX-create-file-prefix-g (file-exists-p file))
420 (find-file-other-window file) t)
421 (t (message "%s was not found in this directory." file)
422 nil)))
424 (defun YaTeX-get-file-buffer (file)
425 "Return the FILE's buffer.
426 Base directory is that of main file or current directory."
427 (let (dir main (cdir default-directory))
428 (or (and (eq major-mode 'yatex-mode)
429 YaTeX-search-file-from-top-directory
430 (save-excursion
431 (YaTeX-visit-main t)
432 (get-file-buffer file)))
433 (get-file-buffer file))))
435 (defun YaTeX-replace-format-sub (string format repl)
436 (let ((beg (or (string-match (concat "^\\(%" format "\\)") string)
437 (string-match (concat "[^%]\\(%" format "\\)") string)))
438 (len (length format)))
439 (if (null beg) string ;no conversion
440 (concat
441 (substring string 0 (match-beginning 1)) (or repl "")
442 (substring string (match-end 1))))))
444 ;;;###autoload
445 (defun YaTeX-replace-format (string format repl)
446 "In STRING, replace first appearance of FORMAT to REPL as if
447 function `format' does. FORMAT does not contain `%'"
448 (let ((ans string) (case-fold-search nil))
449 (while (not (string=
450 ans (setq string (YaTeX-replace-format-sub ans format repl))))
451 (setq ans string))
452 string))
454 ;;;###autoload
455 (defun YaTeX-replace-formats (string replace-list)
456 (let ((list replace-list))
457 (while list
458 (setq string (YaTeX-replace-format
459 string (car (car list)) (cdr (car list)))
460 list (cdr list)))
461 string))
463 ;;;###autoload
464 (defun YaTeX-replace-format-args (string &rest args)
465 "Translate the argument mark #1, #2, ... #n in the STRING into the
466 corresponding real arguments ARGS."
467 (let ((argp 1))
468 (while args
469 (setq string
470 (YaTeX-replace-format string (int-to-string argp) (car args)))
471 (setq args (cdr args) argp (1+ argp))))
472 string)
474 ;;;###autoload
475 (defun rindex (string char)
476 "Return the last position of STRING where character CHAR found."
477 (let ((pos (1- (length string)))(index -1))
478 (catch 'rindex
479 (while (>= pos 0)
480 (cond
481 ((= (aref string pos) char)
482 (throw 'rindex pos))
483 (t (setq pos (1- pos))))))))
485 ;;;###autoload
486 (defun point-beginning-of-line ()
487 (save-excursion (beginning-of-line)(point)))
489 ;;;###autoload
490 (defun point-end-of-line ()
491 (save-excursion (end-of-line)(point)))
493 (defun YaTeX-showup-buffer-bottom-most (x) (nth 3 (window-edges x)))
494 ;;;###autoload
495 (defun YaTeX-showup-buffer (buffer &optional func select)
496 "Make BUFFER show up in certain window (but current window)
497 that gives the maximum value by the FUNC. FUNC should take an argument
498 of its window object. Non-nil for optional third argument SELECT selects
499 that window. This function never selects minibuffer window."
500 (or (and (if (and YaTeX-emacs-19 select window-system)
501 (get-buffer-window buffer t)
502 (get-buffer-window buffer))
503 (progn
504 (if select
505 (goto-buffer-window buffer))
506 t))
507 (let ((window (selected-window))
508 (wlist (YaTeX-window-list)) win w (x 0))
509 (cond
510 ((> (length wlist) 2)
511 (if func
512 (while wlist
513 (setq w (car wlist))
514 (if (and (not (eq window w))
515 (> (funcall func w) x))
516 (setq win w x (funcall func w)))
517 (setq wlist (cdr wlist)))
518 (setq win (get-lru-window)))
519 (select-window win)
520 (switch-to-buffer buffer)
521 (or select (select-window window)))
522 ((= (length wlist) 2)
523 ;(other-window 1);This does not work properly on Emacs-19
524 (select-window (get-lru-window))
525 (switch-to-buffer buffer)
526 (if (< (window-height) (/ YaTeX-default-pop-window-height 2))
527 (enlarge-window (- YaTeX-default-pop-window-height
528 (window-height))))
529 (or select (select-window window)))
530 (t ;if one-window
531 (cond
532 ((and YaTeX-emacs-19 window-system (get-buffer-window buffer t))
533 nil) ;if found in other frame
534 (YaTeX-default-pop-window-height
535 (split-window-calculate-height YaTeX-default-pop-window-height)
536 ;;(pop-to-buffer buffer) ;damn! emacs-19.30
537 (select-window (next-window nil 1))
538 (switch-to-buffer (get-buffer-create buffer))
539 (or select (select-window window)))
540 (t nil)))
541 ))))
543 (cond
544 ((fboundp 'screen-height)
545 (fset 'YaTeX-screen-height 'screen-height)
546 (fset 'YaTeX-screen-width 'screen-width)
547 (fset 'YaTeX-set-screen-height 'set-screen-height)
548 (fset 'YaTeX-set-screen-width 'set-screen-width))
549 ((fboundp 'frame-height)
550 (fset 'YaTeX-screen-height 'frame-height)
551 (fset 'YaTeX-screen-width 'frame-width)
552 (fset 'YaTeX-set-screen-height 'set-frame-height)
553 (fset 'YaTeX-set-screen-width 'set-frame-width))
554 (t (error "I don't know how to run YaTeX on this Emacs...")))
556 ;;;###autoload
557 (defun split-window-calculate-height (height)
558 "Split current window wight specified HEIGHT.
559 If HEIGHT is number, make a new window that has HEIGHT lines.
560 If HEIGHT is string, make a new window that occupies HEIGT % of screen height.
561 Otherwise split window conventionally."
562 (if (one-window-p t)
563 (split-window
564 (selected-window)
565 (max
566 (min
567 (- (YaTeX-screen-height)
568 (if (numberp height)
569 (+ height 2)
570 (/ (* (YaTeX-screen-height)
571 (YaTeX-str2int height))
572 100)))
573 (- (YaTeX-screen-height) window-min-height 1))
574 window-min-height))))
576 ;;;###autoload
577 (defun YaTeX-window-list ()
578 (let*((curw (selected-window)) (win curw) (wlist (list curw)))
579 (while (not (eq curw (setq win (next-window win))))
580 (or (eq win (minibuffer-window))
581 (setq wlist (cons win wlist))))
582 wlist))
584 (if YaTeX-emacs-21
585 ;; Emacs-21's next-window returns other frame's window even if called
586 ;; with argument ALL-FRAMES nil, when called from minibuffer context.
587 ;; Therefore, check frame identity here.
588 (defun YaTeX-window-list ()
589 (let*((curw (selected-window)) (win curw) (wlist (list curw))
590 (curf (window-frame curw)))
591 (while (and (not (eq curw (setq win (next-window win))))
592 (eq curf (window-frame win)))
593 (or (eq win (minibuffer-window))
594 (setq wlist (cons win wlist))))
595 wlist)))
597 ;;;###autoload
598 (defun substitute-all-key-definition (olddef newdef keymap)
599 "Replace recursively OLDDEF with NEWDEF for any keys in KEYMAP now
600 defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF
601 where ever it appears."
602 (if YaTeX-emacs-19
603 (substitute-key-definition olddef newdef keymap global-map)
604 (mapcar
605 (function (lambda (key) (define-key keymap key newdef)))
606 (where-is-internal olddef keymap))))
608 ;;;###autoload
609 (defun YaTeX-match-string (n &optional m)
610 "Return (buffer-substring (match-beginning n) (match-beginning m))."
611 (if (match-beginning n)
612 (YaTeX-buffer-substring (match-beginning n)
613 (match-end (or m n)))))
615 ;;;###autoload
616 (defun YaTeX-minibuffer-complete ()
617 "Complete in minibuffer.
618 If the symbol 'delim is bound and is string, its value is assumed to be
619 the character class of delimiters. Completion will be performed on
620 the last field separated by those delimiters.
621 If the symbol 'quick is bound and is 't, when the try-completion results
622 in t, exit minibuffer immediately."
623 (interactive)
624 (save-restriction
625 (narrow-to-region
626 (if (fboundp 'field-beginning) (field-beginning (point-max)) (point-min))
627 (point-max))
628 (let ((md (match-data)) beg word compl
629 (quick (and (boundp 'quick) (eq quick t)))
630 (displist ;function to display completion-list
631 (function
632 (lambda ()
633 (with-output-to-temp-buffer "*Completions*"
634 (display-completion-list
635 (all-completions word minibuffer-completion-table)))))))
636 (setq beg (if (and (boundp 'delim) (stringp delim))
637 (save-excursion
638 (skip-chars-backward (concat "^" delim))
639 (point))
640 (point-min))
641 word (buffer-substring beg (point-max))
642 compl (try-completion word minibuffer-completion-table))
643 (cond
644 ((eq compl t)
645 (if quick (exit-minibuffer)
646 (let ((p (point)) (max (point-max)))
647 (unwind-protect
648 (progn
649 (goto-char max)
650 (insert " [Sole completion]")
651 (goto-char p)
652 (sit-for 1))
653 (delete-region max (point-max))
654 (goto-char p)))))
655 ((eq compl nil)
656 (ding)
657 (save-excursion
658 (let (p)
659 (unwind-protect
660 (progn
661 (goto-char (setq p (point-max)))
662 (insert " [No match]")
663 (goto-char p)
664 (sit-for 2))
665 (delete-region p (point-max))))))
666 ((string= compl word)
667 (funcall displist))
668 (t (delete-region beg (point-max))
669 (insert compl)
670 (if quick
671 (if (eq (try-completion compl minibuffer-completion-table) t)
672 (exit-minibuffer)
673 (funcall displist)))))
674 (store-match-data md))))
676 (defun YaTeX-minibuffer-quick-complete ()
677 "Set 'quick to 't and call YaTeX-minibuffer-complete.
678 See documentation of YaTeX-minibuffer-complete."
679 (interactive)
680 (let ((quick t))
681 (self-insert-command 1)
682 (YaTeX-minibuffer-complete)))
684 (defun YaTeX-yatex-buffer-list ()
685 (save-excursion
686 (delq nil (mapcar (function (lambda (buf)
687 (set-buffer buf)
688 (if (eq major-mode 'yatex-mode) buf)))
689 (buffer-list)))))
691 (defun foreach-buffers (pattern job)
692 "For each buffer which matches with PATTERN, do JOB."
693 (let ((list (buffer-list)))
694 (save-excursion
695 (while list
696 (set-buffer (car list))
697 (if (or (and (stringp pattern)
698 (buffer-file-name)
699 (string-match pattern (buffer-file-name)))
700 (and (symbolp pattern) major-mode (eq major-mode pattern)))
701 (eval job))
702 (setq list (cdr list))))))
704 (defun goto-buffer-window (buffer)
705 "Select window which is bound to BUFFER.
706 If no such window exist, switch to buffer BUFFER."
707 (interactive "BGoto buffer: ")
708 (if (stringp buffer)
709 (setq buffer (or (get-file-buffer buffer) (get-buffer buffer))))
710 (if (get-buffer buffer)
711 (cond
712 ((get-buffer-window buffer)
713 (select-window (get-buffer-window buffer)))
714 ((and YaTeX-emacs-19 (get-buffer-window buffer t))
715 (let*((win (get-buffer-window buffer t))
716 (frame (window-frame win)))
717 (select-frame frame)
718 (raise-frame frame)
719 (focus-frame frame)
720 (select-window win)
721 (set-mouse-position frame 0 0)
722 (and (featurep 'windows) (fboundp 'win:adjust-window)
723 (win:adjust-window))))
724 ((and (featurep 'windows) (fboundp 'win:get-buffer-window)
725 (let ((w (win:get-buffer-window buffer)))
726 (and w (win:switch-window w))))
727 (select-window (get-buffer-window buffer)))
728 (t (switch-to-buffer buffer)))))
730 ;; Here starts the functions which support gmhist-vs-Emacs19 compatible
731 ;; reading with history.
732 ;;;###autoload
733 (defun completing-read-with-history
734 (prompt table &optional predicate must-match initial hsym)
735 "Completing read with general history: gmhist, Emacs-19."
736 (let ((minibuffer-history
737 (or (symbol-value hsym)
738 (and (boundp 'minibuffer-history) minibuffer-history)))
739 (minibuffer-history-symbol (or hsym 'minibuffer-history)))
740 (prog1
741 (if (fboundp 'completing-read-with-history-in)
742 (completing-read-with-history-in
743 minibuffer-history-symbol prompt table predicate must-match initial)
744 (save-excursion ;work around to avoid cursor warp
745 (completing-read prompt table predicate must-match initial)))
746 (if (and YaTeX-emacs-19 hsym) (set hsym minibuffer-history)))))
748 ;;;###autoload
749 (defun read-from-minibuffer-with-history (prompt &optional init map read hsym)
750 "Read from minibuffer with general history: gmhist, Emacs-19."
751 (cond
752 (YaTeX-emacs-19
753 (save-excursion ;work around to avoid cursor warp
754 (read-from-minibuffer prompt init map read hsym)))
755 (t
756 (let ((minibuffer-history-symbol hsym))
757 (read-from-minibuffer prompt init map read)))))
759 ;;;###autoload
760 (defun read-string-with-history (prompt &optional init hsym)
761 "Read string with history: gmhist(Emacs-18) and Emacs-19."
762 (cond
763 (YaTeX-emacs-19
764 (save-excursion ;work around to avoid cursor warp
765 (read-from-minibuffer prompt init minibuffer-local-map nil hsym)))
766 ((featurep 'gmhist-mh)
767 (read-with-history-in hsym prompt init))
768 (t (read-string prompt init))))
770 (defvar YaTeX-skip-next-reader-char ?\C-j)
771 (defun YaTeX-read-string-or-skip (&rest args)
772 "Read string, or skip if last input char is \C-j."
773 (if (equal (if (boundp 'last-input-event) last-input-event last-input-char)
774 YaTeX-skip-next-reader-char)
775 ""
776 (save-excursion ;work around to avoid cursor warp
777 (apply 'read-string args))))
779 (defun YaTeX-completing-read-or-skip (&rest args)
780 "Do completing-read, or skip if last input char is \C-j."
781 (if (equal (if (boundp 'last-input-event) last-input-event last-input-char)
782 YaTeX-skip-next-reader-char)
783 ""
784 (save-excursion ;work around to avoid cursor warp
785 (apply 'completing-read args))))
787 ;;;###autoload
788 (fset 'YaTeX-rassoc
789 (if (and nil (fboundp 'rassoc) (subrp (symbol-function 'rassoc)))
790 (symbol-function 'rassoc)
791 (function
792 (lambda (key list)
793 (let ((l list))
794 (catch 'found
795 (while l
796 (if (equal key (cdr (car l)))
797 (throw 'found (car l)))
798 (setq l (cdr l)))))))))
800 (defun YaTeX-set-file-coding-system (code coding)
801 "Set current buffer's coding system according to symbol."
802 (cond ((null code)
803 nil)
804 ((boundp 'MULE)
805 (set-file-coding-system coding))
806 ((and YaTeX-emacs-20 (boundp 'buffer-file-coding-system))
807 (setq buffer-file-coding-system
808 (or (and (fboundp 'set-auto-coding) buffer-file-name
809 (save-excursion
810 (goto-char (point-min))
811 (set-auto-coding buffer-file-name (buffer-size))))
812 coding)))
813 ((featurep 'mule)
814 (set-file-coding-system coding))
815 ((boundp 'NEMACS)
816 (make-local-variable 'kanji-fileio-code)
817 (setq kanji-fileio-code code))))
819 (defun YaTeX-insert-file-contents (file visit &optional beg end)
820 (cond
821 ((and (string< "19" emacs-version) (not (featurep 'xemacs)))
822 (insert-file-contents file visit beg end))
823 ((string-match "unix\\|linux" (symbol-name system-type))
824 (let ((default-process-coding-system
825 (and (boundp '*noconv*) (list '*noconv*)))
826 (file-coding-system (and (boundp '*noconv*) '*noconv*))
827 kanji-fileio-code
828 (default-process-kanji-code 0))
829 (call-process shell-file-name file (current-buffer) nil
830 (or (and (boundp 'shell-command-option)
831 shell-command-option)
832 "-c")
833 (format "dd bs=1 count=%d | tail -c +%d" end beg))))
834 (t (insert-file-contents file))))
836 (defun YaTeX-split-string (str &optional sep null)
837 "Split string STR by every occurrence of SEP(regexp).
838 If the optional second argument SEP is nil, it defaults to \"[ \f\t\n\r\v]+\".
839 Do not include null string by default. Non-nil for optional third argument
840 NULL includes null string in a list."
841 (let ((sep (or sep "[ \f\t\n\r\v]+"))
842 list m)
843 (while str
844 (if (setq m (string-match sep str))
845 (progn
846 (if (or (> m 0) null)
847 (setq list (cons (substring str 0 m) list)))
848 (setq str (substring str (match-end 0))))
849 (if (or null (string< "" str))
850 (setq list (cons str list)))
851 (setq str nil)))
852 (nreverse list)))
854 ;;;###autoload
855 (defun YaTeX-delete1 (elt list)
856 "Delete"
857 (let (e)
858 (while (setq e (YaTeX-member elt list))
859 (setq list (delq (car e) list))))
860 list)
861 (if (fboundp 'delete)
862 (fset 'YaTeX-delete (symbol-function 'delete))
863 (fset 'YaTeX-delete (symbol-function 'YaTeX-delete1)))
865 (defun YaTeX-member1 (elt list)
866 (catch 'found
867 (while list
868 (if (equal elt (car list))
869 (throw 'found list))
870 (setq list (cdr list)))))
872 (if (and (fboundp 'member) (subrp (symbol-function 'member)))
873 (fset 'YaTeX-member (symbol-function 'member))
874 (fset 'YaTeX-member (symbol-function 'YaTeX-member1)))
876 ;;;
877 ;; Interface function for windows.el
878 ;;;
879 ;;;###autoload
880 (fset 'YaTeX-last-key
881 (if (fboundp 'win:last-key)
882 'win:last-key
883 (function (lambda () (if (boundp 'last-command-char)
884 last-command-char
885 last-command-event)))))
886 (defun YaTeX-switch-to-window ()
887 "Switch to windows.el's window decided by last pressed key."
888 (interactive)
889 (or (featurep 'windows) (error "Why don't you use `windows.el'?"))
890 (win-switch-to-window 1 (- (YaTeX-last-key) win:base-key)))
893 ;;;###autoload
894 (defun YaTeX-command-to-string (cmd)
895 (if (fboundp 'shell-command-to-string)
896 (funcall 'shell-command-to-string cmd)
897 (let ((tbuf " *tmpout*"))
898 (if (get-buffer-create tbuf) (kill-buffer tbuf))
899 (let ((standard-output (get-buffer-create tbuf)))
900 (unwind-protect
901 (save-excursion
902 (call-process
903 shell-file-name nil tbuf nil YaTeX-shell-command-option cmd)
904 (set-buffer tbuf)
905 (buffer-string))
906 (kill-buffer tbuf))))))
908 ;;; (defun YaTeX-executable-find(cmd)...)
909 (fset 'YaTeX-executable-find
910 (if (fboundp 'executable-find)
911 'executable-find
912 (function (lambda (cmd)
913 (let ((list exec-path) path)
914 (catch 'exec
915 (while list
916 (if (file-executable-p
917 (setq path (expand-file-name cmd (car list))))
918 (throw 'exec path))
919 (setq list (cdr list)))))))))
921 ;;;###autoload
922 (defun YaTeX-reindent (col)
923 "Remove current indentation and reindento to COL column."
924 (save-excursion
925 (beginning-of-line)
926 (skip-chars-forward " \t")
927 (if (/= col (current-column))
928 (progn
929 (delete-region (point) (progn (beginning-of-line) (point)))
930 (indent-to col))))
931 (skip-chars-forward " \t" (point-end-of-line)))
933 (defun YaTeX-inner-environment (&optional quick)
934 "Return current inner-most environment.
935 Non-nil for optional argument QUICK restricts search bound to most
936 recent sectioning command. Matching point is stored to property 'point
937 of 'YaTeX-inner-environment, which can be referred by
938 (get 'YaTeX-inner-environment 'point)."
939 (put 'YaTeX-inner-environment 'point (point-min))
940 (put 'YaTeX-inner-environment 'indent 0)
941 (let*((nest 0)
942 (beg (YaTeX-replace-format-args
943 (regexp-quote YaTeX-struct-begin)
944 ;YaTeX-struct-begin ;=== TENTATIVE!! ==
945 YaTeX-struct-name-regexp
946 (if (eq major-mode 'yahtml-mode) "\\s *.*" "")
947 ""))
948 (end (YaTeX-replace-format-args
949 (regexp-quote YaTeX-struct-end)
950 YaTeX-struct-name-regexp "" ""))
951 (begend (concat "\\(" beg "\\)\\|\\(" end "\\)"))
952 bound m0
953 (htmlp (eq major-mode 'yahtml-mode))
954 (open
955 (concat "^" (or (cdr (assq major-mode '((yahtml-mode . "<")))) "{")))
956 (close
957 (concat "^"
958 (or (cdr(assq major-mode '((yahtml-mode . "\n\t >")))) "}"))))
959 (save-excursion
960 (if quick
961 (setq bound
962 (save-excursion
963 (if htmlp
964 ;;(re-search-backward YaTeX-sectioning-regexp nil 1)
965 ;;(goto-char (point-min)) ;Is this enough? 97/6/26
966 (re-search-backward yahtml-indentation-boundary nil 1)
967 (YaTeX-re-search-active-backward
968 (concat YaTeX-ec-regexp
969 "\\(" YaTeX-sectioning-regexp "\\)\\*?{")
970 YaTeX-comment-prefix nil 1))
971 (or (bobp) (end-of-line))
972 (point))))
973 (if (catch 'begin
974 (if (and (numberp bound) (< (point) bound)) (throw 'begin nil))
975 (while (YaTeX-re-search-active-backward
976 begend YaTeX-comment-prefix bound t)
977 (setq m0 (match-beginning 0))
978 (if (looking-at end) ;;(match-beginning 2)
979 (setq nest (1+ nest))
980 (setq nest (1- nest)))
981 (if (< nest 0)
982 (progn
983 (put 'YaTeX-inner-environment 'point m0)
984 (goto-char m0)
985 (put 'YaTeX-inner-environment 'indent (current-column))
986 (throw 'begin t)))))
987 (YaTeX-buffer-substring
988 (progn (skip-chars-forward open) (1+ (point)))
989 (progn (skip-chars-forward close) (point)))))))
991 (defun YaTeX-in-environment-p (env)
992 "Return if current LaTeX environment is ENV.
993 ENV is given in the form of environment's name or its list."
994 (let ((md (match-data)) (nest 0) p envrx)
995 (cond
996 ((atom env)
997 (setq envrx
998 (concat "\\("
999 (regexp-quote
1000 (YaTeX-replace-format-args
1001 YaTeX-struct-begin env "" ""))
1002 "\\>\\)\\|\\("
1003 (regexp-quote
1004 (YaTeX-replace-format-args
1005 YaTeX-struct-end env "" ""))
1006 "\\)"))
1007 (save-excursion
1008 (setq p (catch 'open
1009 (while (YaTeX-re-search-active-backward
1010 envrx YaTeX-comment-prefix nil t)
1011 (if (match-beginning 2)
1012 (setq nest (1+ nest))
1013 (setq nest (1- nest)))
1014 (if (< nest 0)
1015 (throw 'open (cons env (match-beginning 0)))))))))
1016 ((listp env)
1017 (setq p
1018 (or (YaTeX-in-environment-p (car env))
1019 (and (cdr env) (YaTeX-in-environment-p (cdr env)))))))
1020 (store-match-data md)
1021 p;(or p (YaTeX-in-verb-p (match-beginning 0)))
1022 ))
1024 (defun YaTeX-quick-in-environment-p (env)
1025 "Check quickly but unsure if current environment is ENV.
1026 ENV is given in the form of environment's name or its list.
1027 This function returns correct result only if ENV is NOT nested."
1028 (save-excursion
1029 (let ((md (match-data)) m0 (p (point)) rc clfound)
1030 (cond
1031 ((listp env)
1032 (or (YaTeX-quick-in-environment-p (car env))
1033 (and (cdr env) (YaTeX-quick-in-environment-p (cdr env)))))
1034 (t
1035 (unwind-protect
1036 (if (prog1
1037 (YaTeX-search-active-backward
1038 (YaTeX-replace-format-args YaTeX-struct-begin env "" "")
1039 YaTeX-comment-prefix nil t)
1040 (setq m0 (match-beginning 0)))
1041 (if (YaTeX-search-active-forward
1042 (YaTeX-replace-format-args
1043 YaTeX-struct-end env)
1044 YaTeX-comment-prefix p t nil)
1045 nil ;if \end{env} found, return nil
1046 (cons env m0))) ;else, return meaningful values
1047 (store-match-data md)))))))
1049 (defun YaTeX-goto-corresponding-environment (&optional allow-mismatch noerr bg)
1050 "Go to corresponding begin/end enclosure.
1051 Optional argument ALLOW-MISMATCH allows mismatch open/clese. Use this
1052 for \left(, \right).
1053 Optional third argument NOERR causes no error for unballanced environment."
1054 (interactive)
1055 (if (not (YaTeX-on-begin-end-p)) nil
1056 (let ((p (match-end 0)) b0 b1 env (nest 0) regexp re-s (op (point))
1057 (m0 (match-beginning 0)) ;whole matching
1058 (m1 (match-beginning 1)) ;environment in \begin{}
1059 (m2 (match-beginning 2)) ;environment in \end{}
1060 (m3 (match-beginning 3))) ;environment in \[ \] \( \)
1061 ;(setq env (regexp-quote (buffer-substring p (match-beginning 0))))
1062 (if (cond
1063 (m1 ;if begin{xxx}
1064 (setq env
1065 (if allow-mismatch YaTeX-struct-name-regexp
1066 (regexp-quote (buffer-substring m1 (match-end 1)))))
1067 ; (setq regexp (concat "\\(\\\\end{" env "}\\)\\|"
1068 ; "\\(\\\\begin{" env "}\\)"))
1069 (setq regexp
1070 (concat
1071 "\\("
1072 (YaTeX-replace-format-args
1073 (regexp-quote YaTeX-struct-end) env "" "")
1074 "\\)\\|\\("
1075 (YaTeX-replace-format-args
1076 (regexp-quote YaTeX-struct-begin) env "" "")
1077 "\\)"))
1078 (setq re-s 're-search-forward))
1079 (m2 ;if end{xxx}
1080 (setq env
1081 (if allow-mismatch YaTeX-struct-name-regexp
1082 (regexp-quote (buffer-substring m2 (match-end 2)))))
1083 ; (setq regexp (concat "\\(\\\\begin{" env "}\\)\\|"
1084 ; "\\(\\\\end{" env "}\\)"))
1085 (setq regexp
1086 (concat
1087 "\\("
1088 (YaTeX-replace-format-args
1089 (regexp-quote YaTeX-struct-begin) env "" "")
1090 "\\)\\|\\("
1091 (YaTeX-replace-format-args
1092 (regexp-quote YaTeX-struct-end) env "" "")
1093 "\\)"))
1094 (setq re-s 're-search-backward))
1095 (m3 ;math environment
1096 (setq env (char-after (1+ m3))
1097 regexp (format "\\(%s%s\\)\\|\\(%s%s\\)"
1098 YaTeX-ec-regexp
1099 (regexp-quote
1100 (cdr (assq env '((?( . ")") (?) . "(")
1101 (?[ . "]") (?] . "[")))))
1102 YaTeX-ec-regexp
1103 (regexp-quote (char-to-string env)))
1104 re-s (if (memq env '(?\( ?\[))
1105 're-search-forward
1106 're-search-backward)))
1107 (t (if noerr nil (error "Corresponding environment not found."))))
1108 (progn
1109 (while (and (>= nest 0) (funcall re-s regexp nil t))
1110 (setq b0 (match-beginning 0) b1 (match-beginning 1))
1111 (if (or (equal b0 m0)
1112 (YaTeX-literal-p b0))
1113 nil
1114 (setq nest (if (equal b0 b1)
1115 (1- nest) (1+ nest)))))
1116 (if (< nest 0)
1117 (goto-char (match-beginning 0)) ;found.
1118 (goto-char op)
1119 (funcall
1120 (if noerr 'message 'error)
1121 "Corresponding environment `%s' not found." env)
1122 (or bg (sit-for 1))
1123 nil))))))
1125 (defun YaTeX-end-environment ()
1126 "Close opening environment"
1127 (interactive)
1128 (let ((env (YaTeX-inner-environment)))
1129 (if (not env) (error "No premature environment")
1130 (save-excursion
1131 (if (and
1132 (YaTeX-re-search-active-forward
1133 (concat
1134 "\\(" (YaTeX-replace-format-args
1135 YaTeX-struct-end env "" "")
1136 "\\)\\|\\(" (YaTeX-replace-format-args
1137 YaTeX-struct-begin env "" "")
1138 "\\)")
1139 YaTeX-comment-prefix nil t)
1140 (match-beginning 1)) ;is closing struc.
1141 (if (y-or-n-p
1142 (concat "Environment `" env
1143 "' may be already closed. Force close?"))
1144 nil
1145 (error "end environment aborted."))))
1146 (message "") ;Erase (y or n) message.
1147 (YaTeX-insert-struc 'end env)
1148 (save-excursion
1149 (goto-char (or (get 'YaTeX-inner-environment 'point) (match-end 0)))
1150 (if (pos-visible-in-window-p)
1151 (sit-for (if YaTeX-dos 2 1))
1152 (message "Matches with %s at line %d"
1153 (YaTeX-replace-format-args YaTeX-struct-begin env "" "")
1154 (count-lines (point-min) (point))))))))
1156 (defun YaTeX-beginning-of-environment (&optional limit-search-bound end)
1157 "Goto the beginning of the current environment.
1158 Optional argument LIMIT-SEARCH-BOUND non-nil limits the search bound to
1159 most recent sectioning command. Non-nil for optional third argument END
1160 goes to end of environment."
1161 (interactive)
1162 (let ((op (point)))
1163 (if (YaTeX-inner-environment limit-search-bound)
1164 (progn
1165 (goto-char (get 'YaTeX-inner-environment 'point))
1166 (and end (YaTeX-goto-corresponding-environment))
1167 (if (interactive-p) (push-mark op))
1168 (point)))))
1170 (defun YaTeX-end-of-environment (&optional limit-search-bound)
1171 "Goto the end of the current environment.
1172 Optional argument LIMIT-SEARCH-BOUND non-nil limits the search bound
1173 to most recent sectioning command."
1174 (interactive)
1175 (YaTeX-beginning-of-environment limit-search-bound t))
1177 (defun YaTeX-mark-environment ()
1178 "Mark current position and move point to end of environment."
1179 (interactive)
1180 (require 'yatexmth)
1181 (let ((curp (point)))
1182 (if (YaTeX-in-math-mode-p)
1183 (YaTeX-mark-mathenv)
1184 (if (and (YaTeX-on-begin-end-p) (match-beginning 1)) ;if on \\begin
1185 (progn (goto-char (match-end 0)))
1186 (if (= (char-after (point)) ?\\) nil ;if on \\end
1187 (skip-chars-backward "^\n\\\\")
1188 (or (bolp) (forward-char -1))))
1189 (if (not (YaTeX-end-of-environment)) ;arg1 turns to match-beginning 1
1190 (progn
1191 (goto-char curp)
1192 (error "Cannot found the end of current environment."))
1193 (YaTeX-goto-corresponding-environment)
1194 ;;(beginning-of-line) ;for confirmation ;OUT 2015/1/4
1195 (if (< curp (point))
1196 (progn
1197 (message "Mark this environment?(y or n): ")
1198 (if (= (read-char) ?y) nil
1199 (goto-char curp)
1200 (error "Abort. Please call again at more proper position."))))
1201 (set-mark-command nil)
1202 (YaTeX-goto-corresponding-environment)
1203 (goto-char (match-end 0))
1204 ;;(end-of-line) ;OUT 2015/1/5
1205 ;;(if (eobp) nil (forward-char 1)) ;OUT 2015/1/5
1206 ))))
1208 (defun YaTeX-kill-buffer (buffer)
1209 "Make effort to show parent buffer after kill."
1210 (interactive "bKill buffer: ")
1211 (or (get-buffer buffer)
1212 (error "No such buffer %s" buffer))
1213 (let ((pf YaTeX-parent-file))
1214 (kill-buffer buffer)
1215 (and pf
1216 (get-file-buffer pf)
1217 (switch-to-buffer (get-file-buffer pf)))))
1219 (defun YaTeX-getset-builtin (key &optional value)
1220 "Read source built-in command of %# usage."
1221 (catch 'builtin
1222 (let*((bl (delq nil (list (current-buffer)
1223 (and YaTeX-parent-file
1224 (get-file-buffer YaTeX-parent-file)))))
1225 (tuple (cdr (assq major-mode
1226 '((yatex-mode "%#" . "\n")
1227 (yahtml-mode "<!-- #" . "[ \t]*-->\\|\n")))))
1228 (leader (or (car tuple) ""))
1229 (closer (or (cdr tuple) ""))
1230 (prompt (format "Built-in for %s: " key)))
1231 (save-excursion
1232 (while bl
1233 (set-buffer (car bl))
1234 (save-excursion
1235 (goto-char (point-min))
1236 (if (and (re-search-forward
1237 (concat "^" (regexp-quote (concat leader key))) nil t)
1238 (not (eolp)))
1239 (throw 'builtin
1240 (let (b e w)
1241 (skip-chars-forward " \t" (point-end-of-line))
1242 (setq b (point)
1243 e (if (re-search-forward closer nil t)
1244 (match-beginning 0)
1245 (point-end-of-line))
1246 w (YaTeX-buffer-substring b e))
1247 (if (null value)
1249 (delete-region b e)
1250 (goto-char b)
1251 (if (symbolp value)
1252 (setq value (read-string prompt w)))
1253 (insert value)
1254 value)))))
1255 (setq bl (cdr bl)))
1256 ; not found
1257 (if (null value)
1258 nil ;not set mode, return simply nil
1259 (if (symbolp value)
1260 (setq value (read-string prompt)))
1261 (save-excursion
1262 (goto-char (point-min))
1263 (insert leader key " " value "\n")
1264 value)))))) ;on set mode, return set value
1266 (defun YaTeX-get-builtin (key)
1267 "Read source built-in command of %# usage."
1268 (YaTeX-getset-builtin key))
1270 ;;;VER2
1271 (defun YaTeX-insert-struc (what env)
1272 (cond
1273 ((eq what 'begin)
1274 (insert (YaTeX-replace-format-args
1275 YaTeX-struct-begin env (YaTeX-addin env))))
1276 ((eq what 'end)
1277 (insert (YaTeX-replace-format-args YaTeX-struct-end env)))
1278 (t nil)))
1280 (defun YaTeX-string-width (str)
1281 "Return the display width of string."
1282 (if (fboundp 'string-width)
1283 (string-width str)
1284 (length str)))
1285 (defun YaTeX-truncate-string-width (str width)
1286 (cond
1287 ((fboundp 'truncate-string-to-width) (truncate-string-to-width str width))
1288 ((fboundp 'truncate-string) (truncate-string str width))
1289 (t (substring str 0 width))))
1291 (defun YaTeX-hex (str)
1292 "Return int expressed by hexadecimal string STR."
1293 (if (string< "20" emacs-version)
1294 (string-to-number str 16)
1295 (let ((md (match-data)))
1296 (unwind-protect
1297 (if (string-match "[^0-9a-f]" str)
1298 (error "Non hexadecimal character in %s" str)
1299 (let ((i 0) d)
1300 (setq str (downcase str))
1301 (while (string< "" str)
1302 (setq d (+ 0 (string-to-char str)) ; + 0 for XEmacs
1303 i (+ (* 16 i) (- d (if (<= d ?9) ?0 (- ?a 10))))
1304 str (substring str 1)))
1305 i))
1306 (store-match-data md)))))
1309 ;;; Function for menu support
1310 (defun YaTeX-define-menu (keymap bindlist)
1311 "Define KEYMAP(symbol)'s menu-bindings according to BINDLIST.
1312 KEYMAP should be a quoted symbol of newly allocated keymap.
1313 BINDLIST consists of binding list. Each element is as follows.
1315 '(menusymbol DOC_String . contents)
1317 CONTENTS is one of lambda-form, interactive function, or other keymap.
1318 See yatex19.el for example."
1319 (cond
1320 ((featurep 'xemacs)
1321 (let (name)
1322 (if (keymapp (symbol-value keymap))
1323 (progn
1324 (setq name (keymap-name (symbol-value keymap)))
1325 (set keymap nil))
1326 (setq name (car (symbol-value keymap)))
1327 (set keymap (cdr (symbol-value keymap))))
1328 (mapcar
1329 (function
1330 (lambda (bind)
1331 (setq bind (cdr bind))
1332 (if (eq (car-safe (cdr bind)) 'lambda)
1333 (setcar (cdr bind) 'progn))
1334 (if (stringp (car-safe (cdr bind)))
1335 (set keymap
1336 (cons (cdr bind) (symbol-value keymap)))
1337 (set keymap
1338 (cons (vector (car bind) (cdr bind) t)
1339 (symbol-value keymap))))))
1340 bindlist)
1341 (set keymap (cons name (symbol-value keymap)))))
1342 (t
1343 (mapcar
1344 (function
1345 (lambda (bind)
1346 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
1347 bindlist))))
1349 ;;;
1350 ;; Emacs 21 compensational wrapper
1351 ;;;
1352 (defun YaTeX-minibuffer-begin ()
1353 (if (fboundp 'field-beginning)
1354 (field-beginning (point-max))
1355 (point-min)))
1357 (defun YaTeX-minibuffer-end ()
1358 (if (fboundp 'field-end)
1359 (field-end (point-max))
1360 (point-max)))
1362 (defun YaTeX-minibuffer-string ()
1363 (buffer-substring (YaTeX-minibuffer-begin) (YaTeX-minibuffer-end)))
1365 (defun YaTeX-minibuffer-erase ()
1366 (if (eq (selected-window) (minibuffer-window))
1367 (if (fboundp 'delete-field) (delete-field) (erase-buffer))))
1369 (fset 'YaTeX-buffer-substring
1370 (if (fboundp 'buffer-substring-no-properties)
1371 'buffer-substring-no-properties
1372 'buffer-substring))
1374 (defun YaTeX-region-active-p ()
1375 (and (fboundp 'region-active-p) (region-active-p)))
1377 ;;;
1378 ;; hilit19 vs. font-lock
1379 ;;;
1380 (defvar YaTeX-19-functions-font-lock-direct
1381 '(YaTeX-19-re-search-in-env))
1383 (defun YaTeX-convert-pattern-hilit2fontlock (h19pa)
1384 "Convert hilit19's H19PA patterns alist to font-lock's one.
1385 This function is a makeshift for YaTeX and yahtml."
1386 (let ((ignorecase (not (null (car h19pa))))
1387 (palist (cdr h19pa))
1388 flpa i newface
1389 (mapping
1390 '((bold . YaTeX-font-lock-bold-face)
1391 (italic . YaTeX-font-lock-italic-face)
1392 (defun . font-lock-function-name-face)
1393 (define . font-lock-variable-name-face)
1394 (keyword . font-lock-keyword-face)
1395 (decl . YaTeX-font-lock-declaration-face)
1396 (label . YaTeX-font-lock-label-face)
1397 (crossref . YaTeX-font-lock-crossref-face)
1398 (include . YaTeX-font-lock-include-face)
1399 (formula . YaTeX-font-lock-formula-face)
1400 (delimiter . YaTeX-font-lock-delimiter-face)
1401 (string . ignore) (comment . ignore)
1402 )))
1403 (while (setq i (car palist))
1404 (setq newface (nth 2 i)
1405 newface (or (cdr (assq newface mapping)) newface))
1406 (cond
1407 ((eq newface 'ignore) nil) ;no translation
1408 ((stringp (car i)) ;hiliting by regexp
1409 (setq flpa
1410 (cons
1411 (if (numberp (car (cdr i)))
1412 (list (car i) ;regexp
1413 (car (cdr i)) ;matching group number
1414 newface nil) ;'keep) ;keep is hilit19 taste
1415 (list
1416 (concat
1417 (car i) ;original regexp and..
1418 ;;"[^"
1419 ;;(regexp-quote (substring (car (cdr i)) 0 1))
1420 ;;"]+" ;for shortest match
1421 ".*"
1422 (car (cdr i)))
1423 0 (list 'quote newface) nil)) ;;'keep))
1424 flpa)))
1425 ((and (symbolp (car i)) (fboundp (car i)))
1426 (if (memq (car i) YaTeX-19-functions-font-lock-direct)
1427 ;; Put direct function call for it.
1428 ;; When calling this function, fontify entire matched string.
1429 (setq flpa
1430 (cons
1431 (list
1432 (list 'lambda (list 'dummy) ;dummy should be boundary
1433 (list (car i) (list 'quote (car (cdr i)))))
1434 (list 0 newface))
1435 flpa))
1436 (setq flpa
1437 (cons
1438 (list (car (cdr i)) ;regexp
1439 (list
1440 (list
1441 'lambda (list 'dummy)
1442 '(goto-char (match-beginning 0))
1443 (if (eq (nth 3 i) 'overwrite)
1444 nil
1445 '(remove-text-properties
1446 (point) (min (point-max) (1+ (point)))
1447 '(face nil font-lock-multiline nil)))
1448 (list
1449 'let (list '(e (match-end 0))
1450 (list 'm (list (car i) (car (cdr i)))))
1451 (list
1452 'if 'm
1453 (list
1454 'YaTeX-font-lock-fillin
1455 (list 'car 'm)
1456 (list 'cdr 'm)
1457 (list 'quote 'face)
1458 (list 'quote 'font-lock)
1459 (list 'quote newface))
1460 '(goto-char e)
1461 ))
1462 nil) ;retun nil to cheat font-lock
1463 nil nil)) ;pre-match, post-match both nil
1464 flpa)))))
1465 (setq palist (cdr palist)));while
1466 (if (featurep 'xemacsp)
1467 (nreverse flpa)
1468 flpa)))
1470 (if (and (boundp 'YaTeX-use-font-lock)
1471 YaTeX-use-font-lock)
1472 (require 'font-lock))
1474 (cond
1475 ((and (featurep 'font-lock) (fboundp 'defface))
1476 ;; In each defface, '(class static-color) is for Emacs-21 -nw
1477 ;; '(class tty) is for XEmacs-21 -nw
1478 (defface YaTeX-font-lock-label-face
1479 '((((class static-color)) (:foreground "yellow" :underline t))
1480 (((type tty)) (:foreground "yellow" :underline t))
1481 (((class color) (background dark)) (:foreground "pink" :underline t))
1482 (((class color) (background light)) (:foreground "red" :underline t))
1483 (t (:bold t :underline t)))
1484 "Font Lock mode face used to highlight labels."
1485 :group 'font-lock-faces)
1486 (defvar YaTeX-font-lock-label-face 'YaTeX-font-lock-label-face)
1488 (defface YaTeX-font-lock-declaration-face
1489 '((((class color) (background dark)) (:foreground "cyan"))
1490 (((class color) (background light)) (:foreground "RoyalBlue"))
1491 (t (:bold t :underline t)))
1492 "Font Lock mode face used to highlight some declarations."
1493 :group 'font-lock-faces)
1494 (defvar YaTeX-font-lock-declaration-face 'YaTeX-font-lock-declaration-face)
1496 (defface YaTeX-font-lock-include-face
1497 '((((class color) (background dark)) (:foreground "Plum1"))
1498 (((class color) (background light)) (:foreground "purple"))
1499 (t (:bold t :underline t)))
1500 "Font Lock mode face used to highlight expression for including."
1501 :group 'font-lock-faces)
1502 (defvar YaTeX-font-lock-include-face 'YaTeX-font-lock-include-face)
1504 (defface YaTeX-font-lock-formula-face
1505 '((((class static-color)) (:bold t))
1506 (((type tty)) (:bold t))
1507 (((class color) (background dark)) (:foreground "khaki" :bold t))
1508 (((class color) (background light)) (:foreground "DarkGoldenrod4"))
1509 (t (:bold t :underline t)))
1510 "Font Lock mode face used to highlight formula."
1511 :group 'font-lock-faces)
1512 (defvar YaTeX-font-lock-formula-face 'YaTeX-font-lock-formula-face)
1514 (defface YaTeX-font-lock-delimiter-face
1515 '((((class static-color)) (:bold t))
1516 (((type tty)) (:bold t))
1517 (((class color) (background dark))
1518 (:foreground "lightyellow3" :background "navy" :bold t))
1519 (((class color) (background light)) (:foreground "red"))
1520 (t (:bold t :underline t)))
1521 "Font Lock mode face used to highlight delimiters."
1522 :group 'font-lock-faces)
1523 (defvar YaTeX-font-lock-delimiter-face 'YaTeX-font-lock-delimiter-face)
1525 (defface YaTeX-font-lock-math-sub-face
1526 '((((class static-color)) (:bold t))
1527 (((type tty)) (:bold t))
1528 (((class color) (background dark))
1529 (:foreground "khaki" :bold t :underline t))
1530 (((class color) (background light))
1531 (:foreground "DarkGoldenrod4" :underline t))
1532 (t (:bold t :underline t)))
1533 "Font Lock mode face used to highlight subscripts in formula."
1534 :group 'font-lock-faces)
1535 (defvar YaTeX-font-lock-math-sub-face 'YaTeX-font-lock-math-sub-face)
1537 (defface YaTeX-font-lock-math-sup-face
1538 '((((class static-color)) (:bold t))
1539 (((type tty)) (:bold t))
1540 (((class color) (background dark))
1541 (:bold nil :foreground "ivory" :background "lightyellow4"))
1542 (((class color) (background light))
1543 (:underline t :foreground "DarkGoldenrod3"))
1544 (t (:bold t :underline t)))
1545 "Font Lock mode face used to highlight superscripts in formula."
1546 :group 'font-lock-faces)
1547 (defvar YaTeX-font-lock-math-sup-face 'YaTeX-font-lock-math-sup-face)
1549 (defface YaTeX-font-lock-crossref-face
1550 '((((class color) (background dark)) (:foreground "lightgoldenrod"))
1551 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1552 (t (:bold t :underline t)))
1553 "Font Lock mode face used to highlight cross references."
1554 :group 'font-lock-faces)
1555 (defvar YaTeX-font-lock-crossref-face 'YaTeX-font-lock-crossref-face)
1557 (defface YaTeX-font-lock-bold-face
1558 '((t (:bold t)))
1559 "Font Lock mode face used to express bold itself."
1560 :group 'font-lock-faces)
1561 (defvar YaTeX-font-lock-bold-face 'YaTeX-font-lock-bold-face)
1563 (defface YaTeX-font-lock-italic-face
1564 '((t (:italic t)))
1565 "Font Lock mode face used to express italic itself."
1566 :group 'font-lock-faces)
1567 (defvar YaTeX-font-lock-italic-face 'YaTeX-font-lock-italic-face)
1569 ;; Make sure the 'YaTeX-font-lock-{italic,bold}-face is bound with
1570 ;; italic/bold fontsets
1571 (if (and (fboundp 'fontset-list) YaTeX-use-italic-bold)
1572 (let ((flist (fontset-list)) fnt italic bold
1573 (df (or (and (fboundp 'face-font-name) (face-font-name 'default))
1574 (face-font 'default)
1575 (face-font 'italic)
1576 (face-font 'bold)
1577 "giveup!"))
1578 sz medium-i bold-r)
1579 (if (string-match
1580 "^-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-\\(\\([0-9]+\\)\\)" df)
1581 (setq sz (or (match-string 1 df) "16"))
1582 (setq sz "16"))
1583 (setq medium-i (format "-medium-i-[^-]+--%s" sz)
1584 bold-r (format "-bold-r-[^-]+--%s" sz))
1585 (while flist
1586 (setq fnt (car flist))
1587 (condition-case err
1588 (cond
1589 ((and (string-match medium-i fnt)
1590 (null italic))
1591 (set-face-font 'YaTeX-font-lock-italic-face (setq italic fnt)))
1592 ((and (string-match bold-r fnt) (null bold))
1593 (set-face-font 'YaTeX-font-lock-bold-face (setq bold fnt))))
1594 (error nil))
1595 (setq flist (cdr flist)))))
1597 ;;Borrowed from XEmacs's font-lock.el
1598 (defsubst YaTeX-font-lock-fillin (start end setprop markprop value &optional object)
1599 "Fill in one property of the text from START to END.
1600 Arguments PROP and VALUE specify the property and value to put where none are
1601 already in place. Therefore existing property values are not overwritten.
1602 Optional argument OBJECT is the string or buffer containing the text."
1603 (let ((start (text-property-any start end markprop nil object)) next
1604 (putfunc (if (fboundp 'put-nonduplicable-text-property)
1605 'put-nonduplicable-text-property
1606 'put-text-property)))
1607 (if (eq putfunc 'put-text-property)
1608 (setq markprop setprop))
1609 (while start
1610 (setq next (next-single-property-change start markprop object end))
1611 (funcall putfunc start next setprop value object)
1612 (funcall putfunc start next markprop value object)
1613 (setq start (text-property-any next end markprop nil object)))))
1615 (defun YaTeX-warning-font-lock (mode)
1616 (let ((sw (selected-window)))
1617 ;;(pop-to-buffer (format " *%s warning*" mode))
1618 ;;(erase-buffer)
1619 (momentary-string-display
1620 (cond
1621 (YaTeX-japan
1622 (concat mode " は、既に font-lock に対応しました。\n"
1623 "~/.emacs などにある\n"
1624 "\t(put 'yatex-mode 'font-lock-keywords 'tex-mode)\n"
1625 "\t(put 'yahtml-mode 'font-lock-keywords 'html-mode)\n"
1626 "などの間に合わせの記述はもはや不要です。"))
1627 (t
1628 (concat mode " now supports the font-lock by itself.\n"
1629 "So you can remove the descriptions such as\n"
1630 "\t(put 'yatex-mode 'font-lock-keywords 'tex-mode)\n"
1631 "\t(put 'yahtml-mode 'font-lock-keywords 'html-mode)\n"
1632 "in your ~/.emacs file. Thank you."))) (point))
1633 (select-window sw)))
1634 ))
1636 (defun YaTeX-assoc-regexp (elt alist)
1637 "Like assoc, return a list of whose car match with ELT. Search from ALIST.
1638 Note that each car of cons-cell is regexp. ELT is a plain text to be
1639 compared by regexp."
1640 (let (x)
1641 (catch 'found
1642 (while alist
1643 (setq x (car (car alist)))
1644 (if (string-match x elt)
1645 (throw 'found (car alist)))
1646 (setq alist (cdr alist))))))
1648 (defun YaTeX-push-to-kill-ring (string)
1649 "Push STRING to kill-ring, then show guidance message."
1650 (and (stringp string) (string< "" string)
1651 (let ((key (key-description (where-is-internal 'yank nil t)))
1652 (msg
1653 (if YaTeX-japan
1654 " をkill-ringに入れました。次のyank(%s)で貼付できます"
1655 " is stored into kill-ring. Paste it by yank(%s).")))
1656 (kill-new string)
1657 (message (concat "`%s'" msg) string key))))
1659 (defun YaTeX-elapsed-time (before after)
1660 "Get elapsed time from BEFORE and AFTER, which are given from currente-time."
1661 (if (fboundp 'float) ;Then, current-time function should be.
1662 (let ((mil (float 1000000))) ;To protect parse error before 19
1663 (+ (* (- (nth 0 after) (nth 0 before)) 65536)
1664 (- (nth 1 after) (nth 1 before))
1665 (- (/ (nth 2 after) mil)
1666 (/ (nth 2 before) mil))))))
1668 ;;;
1669 ;; Functions for the Installation time
1670 ;;;
1672 (defun bcf-and-exit ()
1673 "Byte compile rest of argument and kill-emacs."
1674 (if command-line-args-left
1675 (let ((load-path (cons "." load-path)))
1676 (and (fboundp 'set-language-environment)
1677 (featurep 'mule)
1678 (set-language-environment "Japanese"))
1679 (mapcar 'byte-compile-file command-line-args-left)
1680 (kill-emacs))))
1682 (defun tfb-and-exit ()
1683 "Texinfo-format-buffer and kill-emacs."
1684 (if command-line-args-left
1685 (let ((load-path (cons ".." load-path)))
1686 (and (fboundp 'set-language-environment)
1687 (featurep 'mule)
1688 (set-language-environment "Japanese"))
1689 (mapcar (function
1690 (lambda (arg)
1691 (find-file arg)
1692 (texinfo-format-buffer)
1693 (cond
1694 ((fboundp 'set-buffer-file-coding-system)
1695 (set-buffer-file-coding-system 'sjis-dos))
1696 ((fboundp 'set-file-coding-system)
1697 (set-file-coding-system '*sjis*dos))
1698 ((boundp 'NEMACS)
1699 (set (make-local-variable 'kanji-fileio-code) 1)))
1700 (let ((coding-system-for-write buffer-file-coding-system))
1701 (basic-save-buffer))))
1702 command-line-args-left)
1703 (kill-emacs))))
1705 (provide 'yatexlib)