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