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