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