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