yatex

view yatexlib.el @ 533:81af9784a013

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