yatex
view yatexlib.el @ 69:807c1e7e68b7
yahtml-escape-chars-region
Translate <>"& to entity reference.
And inverse translation to above.
yahtml-translate-hyphens-when-comment-region
yahtml-prefer-upcase-attributes
Inquire .htaccess file to determine the file-coding-system.
Completions for StyleSheet.
---yahtml---
Auto insert of \), \|, \] after corresponding \(, \| \].
[prefix] c for \right\left parens.
| author | yuuji |
|---|---|
| date | Thu, 15 Jul 1999 04:58:26 +0000 |
| parents | 0eb6997bee16 |
| children | 44e3a5e1e883 |
line source
1 ;;; -*- Emacs-Lisp -*-
2 ;;; YaTeX and yahtml common libraries, general functions and definitions
3 ;;; yatexlib.el
4 ;;; (c )1994-1999 by HIROSE Yuuji.[yuuji@gentei.org]
5 ;;; Last modified Tue May 4 10:25:55 1999 on firestorm
6 ;;; $Id$
8 ;; General variables
9 (defvar YaTeX-dos (memq system-type '(ms-dos windows-nt OS/2)))
10 (defvar YaTeX-emacs-19 (>= (string-to-int emacs-version) 19))
11 (defvar YaTeX-emacs-20 (>= (string-to-int emacs-version) 20))
12 (defvar YaTeX-user-completion-table
13 (if YaTeX-dos "~/_yatexrc" "~/.yatexrc")
14 "*Default filename in which user completion table is saved.")
16 (defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)
17 "Whether yatex mode is running on Japanese environment or not.")
19 (defvar YaTeX-kanji-code-alist
20 (cond
21 ((boundp '*junet*)
22 (list (cons
23 1
24 (if YaTeX-dos (if (boundp '*sjis-dos*) *sjis-dos* *sjis*dos)
25 *sjis*))
26 '(2 . *junet*) '(3 . *euc-japan*)))
27 (YaTeX-emacs-20
28 ;;(cdr-safe(assq 'coding-system (assoc "Japanese" language-info-alist)))
29 (list (cons
30 1 (cond (YaTeX-dos 'shift_jis-dos)
31 ((member 'shift_jis (coding-system-list)) 'shift_jis-unix)
32 (t 'sjis)))
33 '(2 . iso-2022-jp-unix)
34 '(3 . euc-jp-unix))))
35 "Kanji-code expression translation table.")
36 (defvar YaTeX-inhibit-prefix-letter nil
37 "*T for changing key definitions from [prefix] Letter to [prefix] C-Letter.")
39 (defvar YaTeX-no-begend-shortcut nil
40 "*T for disabling shortcut of begin-type completion, [prefix] b d, etc.")
42 (defvar YaTeX-default-pop-window-height 10
43 "Default typesetting buffer height.
44 If integer, sets the window-height of typesetting buffer.
45 If string, sets the percentage of it.
46 If nil, use default pop-to-buffer.")
48 (defvar YaTeX-create-file-prefix-g nil
49 "*Non-nil creates new file when [prefix] g on \\include{foo}.")
51 (defvar YaTeX-nervous t
52 "*If you are nervous about maintenance of yatexrc, set this value to T.
53 And you will have the local dictionary.")
55 ;----------- work variables ----------------------------------------
56 (defvar YaTeX-typesetting-mode-map nil
57 "Keymap used in YaTeX typesetting buffer")
59 (if YaTeX-typesetting-mode-map nil
60 (setq YaTeX-typesetting-mode-map (make-keymap))
61 ;(suppress-keymap YaTeX-typesetting-mode-map t)
62 (define-key YaTeX-typesetting-mode-map " " 'YaTeX-jump-error-line)
63 (define-key YaTeX-typesetting-mode-map "\C-m" 'YaTeX-send-string)
64 (define-key YaTeX-typesetting-mode-map "1" 'delete-other-windows)
65 (define-key YaTeX-typesetting-mode-map "0" 'delete-window)
66 (define-key YaTeX-typesetting-mode-map "q" 'delete-window))
68 (defvar YaTeX-parent-file nil
69 "*Main LaTeX source file name used when %#! expression doesn't exist.")
70 (make-variable-buffer-local 'YaTeX-parent-file)
72 ;---------- Define default key bindings on YaTeX mode map ----------
73 ;;;###autoload
74 (defun YaTeX-define-key (key binding &optional map)
75 "Define key on YaTeX-prefix-map."
76 (if YaTeX-inhibit-prefix-letter
77 (let ((c (aref key 0)))
78 (cond
79 ((and (>= c ?a) (<= c ?z)) (aset key 0 (1+ (- c ?a))))
80 ((and (>= c ?A) (<= c ?Z) (numberp YaTeX-inhibit-prefix-letter))
81 (aset key 0 (1+ (- c ?A))))
82 (t nil))))
83 (define-key (or map YaTeX-prefix-map) key binding))
85 ;;;###autoload
86 (defun YaTeX-local-table-symbol (symbol)
87 "Return the lisp symbol which keeps local completion table of SYMBOL."
88 (intern (concat "YaTeX$"
89 default-directory
90 (symbol-name symbol))))
92 ;;;###autoload
93 (defun YaTeX-sync-local-table (symbol)
94 "Synchronize local variable SYMBOL.
95 Copy its corresponding directory dependent completion table to SYMBOL."
96 (if (boundp (YaTeX-local-table-symbol symbol))
97 (set symbol (symbol-value (YaTeX-local-table-symbol symbol)))))
99 (defvar YaTeX-user-table-is-read nil
100 "Flag that means whether user completion table has been read or not.")
101 ;;;###autoload
102 (defun YaTeX-read-user-completion-table (&optional forcetoread)
103 "Append user completion table of LaTeX macros"
104 (let*((user-table (expand-file-name YaTeX-user-completion-table))
105 (local-table (expand-file-name (file-name-nondirectory user-table)))
106 var localvar localbuf (curbuf (current-buffer)) sexp)
107 (if YaTeX-user-table-is-read nil
108 (message "Loading user completion table")
109 (if (file-exists-p user-table) (load-file user-table)
110 (message "Welcome to the field of YaTeX. I'm glad to see you!")))
111 (setq YaTeX-user-table-is-read t)
112 (cond
113 ((file-exists-p local-table)
114 (set-buffer (setq localbuf (find-file-noselect local-table)))
115 (widen)
116 (goto-char (point-min))
117 (while (re-search-forward "(setq \\([^ ]+\\)" nil t)
118 (setq var (intern (buffer-substring
119 (match-beginning 1) (match-end 1)))
120 localvar (YaTeX-local-table-symbol var))
121 (goto-char (match-beginning 0))
122 (setq sexp (buffer-substring (point)
123 (progn (forward-sexp) (point))))
124 (set-buffer curbuf)
125 (or (assq var (buffer-local-variables)) (make-local-variable var))
126 (eval (read sexp))
127 (or (and (boundp localvar)
128 (symbol-value localvar)
129 (not forcetoread))
130 (set localvar (symbol-value var)))
131 (set-buffer localbuf))
132 (kill-buffer localbuf)))
133 (set-buffer curbuf)))
135 ;;;###autoload
136 (defun YaTeX-reload-dictionary ()
137 "Reload local dictionary.
138 Use this function after editing ./.yatexrc."
139 (interactive)
140 (let ((YaTeX-user-table-is-read nil))
141 (YaTeX-read-user-completion-table t)))
143 ;;;###autoload
144 (defun YaTeX-lookup-table (word type)
145 "Lookup WORD in completion table whose type is TYPE.
146 This function refers the symbol tmp-TYPE-table, user-TYPE-table, TYPE-table.
147 Typically, TYPE is one of 'env, 'section, 'fontsize, 'singlecmd."
148 (if (symbolp type) (setq type (symbol-name type)))
149 (or (assoc word (symbol-value (intern (concat "tmp-" type "-table"))))
150 (assoc word (symbol-value (intern (concat "user-" type "-table"))))
151 (assoc word (symbol-value (intern (concat type "-table"))))))
153 ;;;###autoload
154 (defun YaTeX-update-table (vallist default-table user-table local-table)
155 "Update completion table if the car of VALLIST is not in current tables.
156 Second argument DEFAULT-TABLE is the quoted symbol of default completion
157 table, third argument USER-TABLE is user table which will be saved in
158 YaTeX-user-completion-table, fourth argument LOCAL-TABLE should have the
159 completion which is valid during current Emacs's session. If you
160 want to make LOCAL-TABLE valid longer span (but restrict in this directory)
161 create the file in current directory which has the same name with
162 YaTeX-user-completion-table."
163 (let ((car-v (car vallist)) key answer
164 (file (file-name-nondirectory YaTeX-user-completion-table)))
165 (cond
166 ((assoc car-v (symbol-value default-table))
167 nil) ;Nothing to do
168 ((setq key (assoc car-v (symbol-value user-table)))
169 (if (equal (cdr vallist) (cdr key)) nil
170 ;; if association hits, but contents differ.
171 (message
172 "%s's attributes turned into %s" (car vallist) (cdr vallist))
173 (set user-table (delq key (symbol-value user-table)))
174 (set user-table (cons vallist (symbol-value user-table)))
175 (YaTeX-update-dictionary
176 YaTeX-user-completion-table user-table "user")))
177 ((setq key (assoc car-v (symbol-value local-table)))
178 (if (equal (cdr vallist) (cdr key)) nil
179 (message
180 "%s's attributes turned into %s" (car vallist) (cdr vallist))
181 (set local-table (delq key (symbol-value local-table)))
182 (set local-table (cons vallist (symbol-value local-table)))
183 (set (YaTeX-local-table-symbol local-table) (symbol-value local-table))
184 (YaTeX-update-dictionary file local-table)))
185 ;; All of above cases, there are some completion in tables.
186 ;; Then update tables.
187 (t
188 (if (not YaTeX-nervous)
189 (setq answer "u")
190 (message
191 (cond
192 (YaTeX-japan
193 "`%s'の登録先: U)ユーザ辞書 L)ローカル辞書 N)メモリ D)しない")
194 (t
195 "Register `%s' into: U)serDic L)ocalDic N)one D)iscard"))
196 (if (> (length car-v) 23)
197 (concat (substring car-v 0 10) "..." (substring car-v -9))
198 car-v))
199 (setq answer (char-to-string (read-char))))
200 (cond
201 ((string-match answer "uy")
202 (set user-table (cons vallist (symbol-value user-table)))
203 (YaTeX-update-dictionary YaTeX-user-completion-table user-table "user")
204 )
205 ((string-match answer "tl")
206 (set local-table (cons vallist (symbol-value local-table)))
207 (set (YaTeX-local-table-symbol local-table) (symbol-value local-table))
208 (YaTeX-update-dictionary file local-table))
209 ((string-match answer "d") nil) ;discard it
210 (t (set default-table
211 (cons vallist (symbol-value default-table)))))))))
213 ;;;###autoload
214 (defun YaTeX-cplread-with-learning
215 (prom default-table user-table local-table
216 &optional pred reqmatch init hsym)
217 "Completing read with learning.
218 Do a completing read with prompt PROM. Completion table is what
219 DEFAULT-TABLE, USER-TABLE, LOCAL table are appended in reverse order.
220 Note that these tables are passed by the symbol.
221 Optional arguments PRED, REQMATH and INIT are passed to completing-read
222 as its arguments PREDICATE, REQUIRE-MATCH and INITIAL-INPUT respectively.
223 If optional 8th argument HSYM, history symbol, is passed, use it as
224 history list variable."
225 (YaTeX-sync-local-table local-table)
226 (let*((table (append (symbol-value local-table)
227 (symbol-value user-table)
228 (symbol-value default-table)))
229 (word (completing-read-with-history
230 prom table pred reqmatch init hsym)))
231 (if (and (string< "" word) (not (assoc word table)))
232 (YaTeX-update-table (list word) default-table user-table local-table))
233 word))
235 ;;;###autoload
236 (defun YaTeX-update-dictionary (file symbol &optional type)
237 (let ((local-table-buf (find-file-noselect file))
238 (name (symbol-name symbol))
239 (value (symbol-value symbol)))
240 (save-excursion
241 (message "Updating %s dictionary..." (or type "local"))
242 (set-buffer local-table-buf)
243 (goto-char (point-max))
244 (search-backward (concat "(setq " name) nil t)
245 (delete-region (point) (progn (forward-sexp) (point)))
246 (delete-blank-lines)
247 (insert "(setq " name " '(\n")
248 (mapcar '(lambda (s)
249 (insert (format "%s\n" (prin1-to-string s))))
250 value)
251 (insert "))\n\n")
252 (delete-blank-lines)
253 (basic-save-buffer)
254 (kill-buffer local-table-buf)
255 (message "Updating %s dictionary...Done" (or type "local")))))
257 ;;;###autoload
258 (defun YaTeX-define-begend-key-normal (key env &optional map)
259 "Define short cut YaTeX-make-begin-end key."
260 (YaTeX-define-key
261 key
262 (list 'lambda '(arg) '(interactive "P")
263 (list 'YaTeX-insert-begin-end env 'arg))
264 map))
266 ;;;###autoload
267 (defun YaTeX-define-begend-region-key (key env &optional map)
268 "Define short cut YaTeX-make-begin-end-region key."
269 (YaTeX-define-key key (list 'lambda nil '(interactive)
270 (list 'YaTeX-insert-begin-end env t)) map))
272 ;;;###autoload
273 (defun YaTeX-define-begend-key (key env &optional map)
274 "Define short cut key for begin type completion both for normal
275 and region mode. To customize YaTeX, user should use this function."
276 (YaTeX-define-begend-key-normal key env map)
277 (if YaTeX-inhibit-prefix-letter nil
278 (YaTeX-define-begend-region-key
279 (concat (upcase (substring key 0 1)) (substring key 1)) env)))
281 ;;;###autoload
282 (defun YaTeX-search-active-forward (string cmntrx &optional bound err cnt func)
283 "Search STRING which is not commented out by CMNTRX.
284 Optional arguments after BOUND, ERR, CNT are passed literally to search-forward
285 or search-backward.
286 Optional sixth argument FUNC changes search-function."
287 (let ((sfunc (or func 'search-forward)) found md)
288 (while (and (prog1
289 (setq found (funcall sfunc string bound err cnt))
290 (setq md (match-data)))
291 (or
292 (and (eq major-mode 'yatex-mode)
293 (YaTeX-in-verb-p (match-beginning 0)))
294 (save-excursion
295 (beginning-of-line)
296 (re-search-forward cmntrx (match-beginning 0) t)))))
297 (store-match-data md)
298 found))
300 (defun YaTeX-re-search-active-forward (regexp cmntrx &optional bound err cnt)
301 "Search REGEXP backward which is not commented out by regexp CMNTRX.
302 See also YaTeX-search-active-forward."
303 (YaTeX-search-active-forward regexp cmntrx bound err cnt 're-search-forward))
305 (defun YaTeX-search-active-backward (string cmntrx &optional bound err cnt)
306 "Search STRING backward which is not commented out by regexp CMNTRX.
307 See also YaTeX-search-active-forward."
308 (YaTeX-search-active-forward string cmntrx bound err cnt 'search-backward))
310 (defun YaTeX-re-search-active-backward (regexp cmntrx &optional bound err cnt)
311 "Search REGEXP backward which is not commented out by regexp CMNTRX.
312 See also YaTeX-search-active-forward."
313 (YaTeX-search-active-forward
314 regexp cmntrx bound err cnt 're-search-backward))
316 ;;;###autoload
317 (defun YaTeX-switch-to-buffer (file &optional setbuf)
318 "Switch to buffer if buffer exists, find file if not.
319 Optional second arg SETBUF t make use set-buffer instead of switch-to-buffer."
320 (interactive "Fswitch to file: ")
321 (if (bufferp file) (setq file (buffer-file-name file)))
322 (let (buf (hilit-auto-highlight (not setbuf)))
323 (cond
324 ((setq buf (get-file-buffer file))
325 (funcall (if setbuf 'set-buffer 'switch-to-buffer)
326 (get-file-buffer file))
327 buf)
328 ((or YaTeX-create-file-prefix-g (file-exists-p file))
329 (or ;find-file returns nil but set current-buffer...
330 (if setbuf (set-buffer (find-file-noselect file))
331 (find-file file))
332 (current-buffer)))
333 (t (message "%s was not found in this directory." file)
334 nil))))
336 ;;;###autoload
337 (defun YaTeX-switch-to-buffer-other-window (file)
338 "Switch to buffer if buffer exists, find file if not."
339 (interactive "Fswitch to file: ")
340 (if (bufferp file) (setq file (buffer-file-name file)))
341 (cond
342 ((get-file-buffer file)
343 (switch-to-buffer-other-window (get-file-buffer file))
344 t)
345 ((or YaTeX-create-file-prefix-g (file-exists-p file))
346 (find-file-other-window file) t)
347 (t (message "%s was not found in this directory." file)
348 nil)))
350 (defun YaTeX-replace-format-sub (string format repl)
351 (let ((beg (or (string-match (concat "^\\(%" format "\\)") string)
352 (string-match (concat "[^%]\\(%" format "\\)") string)))
353 (len (length format)))
354 (if (null beg) string ;no conversion
355 (concat
356 (substring string 0 (match-beginning 1)) repl
357 (substring string (match-end 1))))))
359 ;;;###autoload
360 (defun YaTeX-replace-format (string format repl)
361 "In STRING, replace first appearance of FORMAT to REPL as if
362 function `format' does. FORMAT does not contain `%'"
363 (let ((ans string))
364 (while (not (string=
365 ans (setq string (YaTeX-replace-format-sub ans format repl))))
366 (setq ans string))
367 string))
369 ;;;###autoload
370 (defun YaTeX-replace-format-args (string &rest args)
371 "Translate the argument mark #1, #2, ... #n in the STRING into the
372 corresponding real arguments ARGS."
373 (let ((argp 1))
374 (while args
375 (setq string
376 (YaTeX-replace-format string (int-to-string argp) (car args)))
377 (setq args (cdr args) argp (1+ argp))))
378 string)
380 ;;;###autoload
381 (defun rindex (string char)
382 (let ((pos (1- (length string)))(index -1))
383 (while (>= pos 0)
384 (cond
385 ((= (aref string pos) char)
386 (setq index pos) (setq pos -1))
387 (t (setq pos (1- pos))))
388 )
389 index))
391 ;;;###autoload
392 (defun point-beginning-of-line ()
393 (save-excursion (beginning-of-line)(point)))
395 ;;;###autoload
396 (defun point-end-of-line ()
397 (save-excursion (end-of-line)(point)))
400 ;;;###autoload
401 (defun YaTeX-showup-buffer (buffer &optional func select)
402 "Make BUFFER show up in certain window (but current window)
403 that gives the maximum value by the FUNC. FUNC should take an argument
404 of its window object. Non-nil for optional third argument SELECT selects
405 that window. This function never selects minibuffer window."
406 (or (and (if (and YaTeX-emacs-19 select)
407 (get-buffer-window buffer t)
408 (get-buffer-window buffer))
409 (progn
410 (if select
411 (goto-buffer-window buffer))
412 t))
413 (let ((window (selected-window))
414 (wlist (YaTeX-window-list)) win w (x 0))
415 (cond
416 ((> (length wlist) 2)
417 (if func
418 (while wlist
419 (setq w (car wlist))
420 (if (and (not (eq window w))
421 (> (funcall func w) x))
422 (setq win w x (funcall func w)))
423 (setq wlist (cdr wlist)))
424 (setq win (get-lru-window)))
425 (select-window win)
426 (switch-to-buffer buffer)
427 (or select (select-window window)))
428 ((= (length wlist) 2)
429 ;(other-window 1);This does not work properly on Emacs-19
430 (select-window (get-lru-window))
431 (switch-to-buffer buffer)
432 (or select (select-window window)))
433 (t ;if one-window
434 (cond
435 ((and YaTeX-emacs-19 (get-buffer-window buffer t))
436 nil) ;if found in other frame
437 (YaTeX-default-pop-window-height
438 (split-window-calculate-height YaTeX-default-pop-window-height)
439 ;;(pop-to-buffer buffer) ;damn! emacs-19.30
440 (select-window (next-window nil 1))
441 (switch-to-buffer (get-buffer-create buffer))
442 (or select (select-window window)))
443 (t nil)))
444 ))))
446 (cond
447 ((fboundp 'screen-height)
448 (fset 'YaTeX-screen-height 'screen-height)
449 (fset 'YaTeX-screen-width 'screen-width))
450 ((fboundp 'frame-height)
451 (fset 'YaTeX-screen-height 'frame-height)
452 (fset 'YaTeX-screen-width 'frame-width))
453 (t (error "I don't know how to run windows.el on this Emacs...")))
455 ;;;###autoload
456 (defun split-window-calculate-height (height)
457 "Split current window wight specified HEIGHT.
458 If HEIGHT is number, make a new window that has HEIGHT lines.
459 If HEIGHT is string, make a new window that occupies HEIGT % of screen height.
460 Otherwise split window conventionally."
461 (if (one-window-p t)
462 (split-window
463 (selected-window)
464 (max
465 (min
466 (- (YaTeX-screen-height)
467 (if (numberp height)
468 (+ height 2)
469 (/ (* (YaTeX-screen-height)
470 (string-to-int height))
471 100)))
472 (- (YaTeX-screen-height) window-min-height 1))
473 window-min-height))))
475 ;;;###autoload
476 (defun YaTeX-window-list ()
477 (let*((curw (selected-window)) (win curw) (wlist (list curw)))
478 (while (not (eq curw (setq win (next-window win))))
479 (or (eq win (minibuffer-window))
480 (setq wlist (cons win wlist))))
481 wlist))
483 ;;;###autoload
484 (defun substitute-all-key-definition (olddef newdef keymap)
485 "Replace recursively OLDDEF with NEWDEF for any keys in KEYMAP now
486 defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF
487 where ever it appears."
488 (if YaTeX-emacs-19
489 (substitute-key-definition olddef newdef keymap global-map)
490 (mapcar
491 (function (lambda (key) (define-key keymap key newdef)))
492 (where-is-internal olddef keymap))))
494 ;;;###autoload
495 (defun YaTeX-match-string (n &optional m)
496 "Return (buffer-substring (match-beginning n) (match-beginning m))."
497 (if (match-beginning n)
498 (buffer-substring (match-beginning n)
499 (match-end (or m n)))))
501 ;;;###autoload
502 (defun YaTeX-minibuffer-complete ()
503 "Complete in minibuffer.
504 If the symbol 'delim is bound and is string, its value is assumed to be
505 the character class of delimiters. Completion will be performed on
506 the last field separated by those delimiters.
507 If the symbol 'quick is bound and is 't, when the try-completion results
508 in t, exit minibuffer immediately."
509 (interactive)
510 (let ((md (match-data)) beg word compl
511 (quick (and (boundp 'quick) (eq quick t)))
512 (displist ;function to display completion-list
513 (function
514 (lambda ()
515 (with-output-to-temp-buffer "*Completions*"
516 (display-completion-list
517 (all-completions word minibuffer-completion-table)))))))
518 (setq beg (if (and (boundp 'delim) (stringp delim))
519 (save-excursion
520 (skip-chars-backward (concat "^" delim))
521 (point))
522 (point-min))
523 word (buffer-substring beg (point-max))
524 compl (try-completion word minibuffer-completion-table))
525 (cond
526 ((eq compl t)
527 (if quick (exit-minibuffer)
528 (let ((p (point)) (max (point-max)))
529 (unwind-protect
530 (progn
531 (goto-char max)
532 (insert " [Sole completion]")
533 (goto-char p)
534 (sit-for 1))
535 (delete-region max (point-max))
536 (goto-char p)))))
537 ((eq compl nil)
538 (ding)
539 (save-excursion
540 (let (p)
541 (unwind-protect
542 (progn
543 (goto-char (setq p (point-max)))
544 (insert " [No match]")
545 (goto-char p)
546 (sit-for 2))
547 (delete-region p (point-max))))))
548 ((string= compl word)
549 (funcall displist))
550 (t (delete-region beg (point-max))
551 (insert compl)
552 (if quick
553 (if (eq (try-completion compl minibuffer-completion-table) t)
554 (exit-minibuffer)
555 (funcall displist)))))
556 (store-match-data md)))
558 (defun YaTeX-minibuffer-quick-complete ()
559 "Set 'quick to 't and call YaTeX-minibuffer-complete.
560 See documentation of YaTeX-minibuffer-complete."
561 (interactive)
562 (let ((quick t))
563 (self-insert-command 1)
564 (YaTeX-minibuffer-complete)))
566 (defun foreach-buffers (pattern job)
567 "For each buffer which matches with PATTERN, do JOB."
568 (let ((list (buffer-list)))
569 (save-excursion
570 (while list
571 (set-buffer (car list))
572 (if (or (and (stringp pattern)
573 (buffer-file-name)
574 (string-match pattern (buffer-file-name)))
575 (and (symbolp pattern) major-mode (eq major-mode pattern)))
576 (eval job))
577 (setq list (cdr list))))))
579 (defun goto-buffer-window (buffer)
580 "Select window which is bound to BUFFER.
581 If no such window exist, switch to buffer BUFFER."
582 (interactive "BGoto buffer: ")
583 (if (stringp buffer)
584 (setq buffer (or (get-file-buffer buffer) (get-buffer buffer))))
585 (if (get-buffer buffer)
586 (cond
587 ((get-buffer-window buffer)
588 (select-window (get-buffer-window buffer)))
589 ((and YaTeX-emacs-19 (get-buffer-window buffer t))
590 (let*((win (get-buffer-window buffer t))
591 (frame (window-frame win)))
592 (select-frame frame)
593 (raise-frame frame)
594 (focus-frame frame)
595 (select-window win)
596 (set-mouse-position frame 0 0)
597 (and (featurep 'windows) (fboundp 'win:adjust-window)
598 (win:adjust-window))))
599 ((and (featurep 'windows) (fboundp 'win:get-buffer-window)
600 (let ((w (win:get-buffer-window buffer)))
601 (and w (win:switch-window w))))
602 (select-window (get-buffer-window buffer)))
603 (t (switch-to-buffer buffer)))))
605 ;; Here starts the functions which support gmhist-vs-Emacs19 compatible
606 ;; reading with history.
607 ;;;###autoload
608 (defun completing-read-with-history
609 (prompt table &optional predicate must-match initial hsym)
610 "Completing read with general history: gmhist, Emacs-19."
611 (let ((minibuffer-history
612 (or (symbol-value hsym)
613 (and (boundp 'minibuffer-history) minibuffer-history)))
614 (minibuffer-history-symbol (or hsym 'minibuffer-history)))
615 (prog1
616 (if (fboundp 'completing-read-with-history-in)
617 (completing-read-with-history-in
618 minibuffer-history-symbol prompt table predicate must-match initial)
619 (completing-read prompt table predicate must-match initial))
620 (if (and YaTeX-emacs-19 hsym) (set hsym minibuffer-history)))))
622 ;;;###autoload
623 (defun read-from-minibuffer-with-history (prompt &optional init map read hsym)
624 "Read from minibuffer with general history: gmhist, Emacs-19."
625 (cond
626 (YaTeX-emacs-19
627 (read-from-minibuffer prompt init map read hsym))
628 (t
629 (let ((minibuffer-history-symbol hsym))
630 (read-from-minibuffer prompt init map read)))))
632 ;;;###autoload
633 (defun read-string-with-history (prompt &optional init hsym)
634 "Read string with history: gmhist(Emacs-18) and Emacs-19."
635 (cond
636 (YaTeX-emacs-19
637 (read-from-minibuffer prompt init minibuffer-local-map nil hsym))
638 ((featurep 'gmhist-mh)
639 (read-with-history-in hsym prompt init))
640 (t (read-string prompt init))))
642 ;;;###autoload
643 (fset 'YaTeX-rassoc
644 (if (and nil (fboundp 'rassoc) (subrp (symbol-function 'rassoc)))
645 (symbol-function 'rassoc)
646 (lambda (key list)
647 (let ((l list))
648 (catch 'found
649 (while l
650 (if (equal key (cdr (car l)))
651 (throw 'found (car l)))
652 (setq l (cdr l))))))))
654 ;;;
655 ;; Interface function for windows.el
656 ;;;
657 ;;;###autoload
658 (defun YaTeX-switch-to-window ()
659 "Switch to windows.el's window decided by last pressed key."
660 (interactive)
661 (or (featurep 'windows) (error "Why don't you use `windows.el'?"))
662 (win-switch-to-window 1 (- last-command-char win:base-key)))
664 ;;;###autoload
665 (defun YaTeX-reindent (col)
666 "Remove current indentation and reindento to COL column."
667 (save-excursion
668 (beginning-of-line)
669 (skip-chars-forward " \t")
670 (if (/= col (current-column))
671 (progn
672 (delete-region (point) (progn (beginning-of-line) (point)))
673 (indent-to col))))
674 (skip-chars-forward " \t" (point-end-of-line)))
676 (defun YaTeX-inner-environment (&optional quick)
677 "Return current inner-most environment.
678 Non-nil for optional argument QUICK restricts search bound to most
679 recent sectioning command. Matching point is stored to property 'point
680 of 'YaTeX-inner-environment, which can be referred by
681 (get 'YaTeX-inner-environment 'point)."
682 (let*((nest 0)
683 (beg (YaTeX-replace-format-args
684 (regexp-quote YaTeX-struct-begin)
685 ;YaTeX-struct-begin ;=== TENTATIVE!! ==
686 YaTeX-struct-name-regexp
687 (if (eq major-mode 'yahtml-mode) "\\s *.*" "")
688 ""))
689 (end (YaTeX-replace-format-args
690 (regexp-quote YaTeX-struct-end)
691 YaTeX-struct-name-regexp "" ""))
692 (begend (concat "\\(" beg "\\)\\|\\(" end "\\)"))
693 bound m0
694 (htmlp (eq major-mode 'yahtml-mode))
695 (open
696 (concat "^" (or (cdr (assq major-mode '((yahtml-mode . "<")))) "{")))
697 (close
698 (concat "^"
699 (or (cdr(assq major-mode '((yahtml-mode . "\n\t >")))) "}"))))
700 (save-excursion
701 (if quick
702 (setq bound
703 (save-excursion
704 (if htmlp
705 ;;(re-search-backward YaTeX-sectioning-regexp nil 1)
706 (goto-char (point-min)) ;Is this enough? 97/6/26
707 (YaTeX-re-search-active-backward
708 (concat YaTeX-ec-regexp
709 "\\(" YaTeX-sectioning-regexp "\\)\\*?{")
710 YaTeX-comment-prefix nil 1))
711 (or (bobp) (end-of-line))
712 (point))))
713 (if (catch 'begin
714 (if (and (numberp bound) (< (point) bound)) (throw 'begin nil))
715 (while (YaTeX-re-search-active-backward
716 begend YaTeX-comment-prefix bound t)
717 (setq m0 (match-beginning 0))
718 (if (looking-at end) ;;(match-beginning 2)
719 (setq nest (1+ nest))
720 (setq nest (1- nest)))
721 (if (< nest 0)
722 (progn
723 (put 'YaTeX-inner-environment 'point m0)
724 (goto-char m0)
725 (put 'YaTeX-inner-environment 'indent (current-column))
726 (throw 'begin t)))))
727 (buffer-substring
728 (progn (skip-chars-forward open) (1+ (point)))
729 (progn (skip-chars-forward close) (point)))))))
731 (defun YaTeX-end-environment ()
732 "Close opening environment"
733 (interactive)
734 (let ((env (YaTeX-inner-environment)))
735 (if (not env) (error "No premature environment")
736 (save-excursion
737 (if (YaTeX-search-active-forward
738 (YaTeX-replace-format-args YaTeX-struct-end env "" "")
739 YaTeX-comment-prefix nil t)
740 (if (y-or-n-p
741 (concat "Environment `" env
742 "' may be already closed. Force close?"))
743 nil
744 (error "end environment aborted."))))
745 (message "") ;Erase (y or n) message.
746 (YaTeX-insert-struc 'end env)
747 (save-excursion
748 (goto-char (or (get 'YaTeX-inner-environment 'point) (match-end 0)))
749 (if (pos-visible-in-window-p)
750 (sit-for (if YaTeX-dos 2 1))
751 (message "Matches with %s at line %d"
752 (YaTeX-replace-format-args YaTeX-struct-begin env "" "")
753 (count-lines (point-min) (point))))))))
755 ;;;VER2
756 (defun YaTeX-insert-struc (what env)
757 (cond
758 ((eq what 'begin)
759 (insert (YaTeX-replace-format-args
760 YaTeX-struct-begin env (YaTeX-addin env))))
761 ((eq what 'end)
762 (insert (YaTeX-replace-format-args YaTeX-struct-end env)))
763 (t nil)))
765 ;;; Function for menu support
766 (defun YaTeX-define-menu (keymap bindlist)
767 "Define KEYMAP(symbol)'s menu-bindings according to BINDLIST.
768 KEYMAP should be a quoted symbol of newly allocated keymap.
769 BINDLIST consists of binding list. Each element is as follows.
771 '(menusymbol DOC_String . contents)
773 CONTENTS is one of lambda-form, interactive function, or other keymap.
774 See yatex19.el for example."
775 (cond
776 ((featurep 'xemacs)
777 (let (name)
778 (if (keymapp (symbol-value keymap))
779 (progn
780 (setq name (keymap-name (symbol-value keymap)))
781 (set keymap nil))
782 (setq name (car (symbol-value keymap)))
783 (set keymap (cdr (symbol-value keymap))))
784 (mapcar
785 (function
786 (lambda (bind)
787 (setq bind (cdr bind))
788 (if (eq (car-safe (cdr bind)) 'lambda)
789 (setcar (cdr bind) 'progn))
790 (if (stringp (car-safe (cdr bind)))
791 (set keymap
792 (cons (cdr bind) (symbol-value keymap)))
793 (set keymap
794 (cons (vector (car bind) (cdr bind) t)
795 (symbol-value keymap))))))
796 bindlist)
797 (set keymap (cons name (symbol-value keymap)))))
798 (t
799 (mapcar
800 (function
801 (lambda (bind)
802 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
803 bindlist))))
806 ;;;
807 ;; Functions for the Installation time
808 ;;;
810 (defun bcf-and-exit ()
811 "Byte compile rest of argument and kill-emacs."
812 (if command-line-args-left
813 (let ((load-path (cons "." load-path)))
814 (and (fboundp 'set-language-environment)
815 (featurep 'mule)
816 (set-language-environment "Japanese"))
817 (mapcar 'byte-compile-file command-line-args-left)
818 (kill-emacs))))
821 (provide 'yatexlib)