yatex: 0734be649cb8 yatexlib.el

yatex

view yatexlib.el @ 79:0734be649cb8

Do not care file-coding-system when YaTeX-kanji-code is nil. New completion yatexpkg.el is introduced.

author	yuuji
date	Thu, 25 Dec 2003 04:10:32 +0000
parents	1b172d26b55e
children	9b4354af748c

line source

1 ;;; -*- Emacs-Lisp -*-

2 ;;; YaTeX and yahtml common libraries, general functions and definitions

3 ;;; yatexlib.el

5 ;;; Last modified Tue Aug 19 22:20:40 2003 on firestorm

6 ;;; $Id$

8 ;; General variables

9 (defvar YaTeX-dos (memq system-type '(ms-dos windows-nt OS/2)))

10 (defvar YaTeX-macos (memq system-type '(darwin)))

11 (defvar YaTeX-emacs-19 (>= (string-to-int emacs-version) 19))

12 (defvar YaTeX-emacs-20 (>= (string-to-int emacs-version) 20))

13 (defvar YaTeX-emacs-21 (>= (string-to-int emacs-version) 21))

14 (defvar YaTeX-user-completion-table

15 (if YaTeX-dos "~/_yatexrc" "~/.yatexrc")

16 "*Default filename in which user completion table is saved.")

18 (defvar YaTeX-display-color-p

19 (or (and (fboundp 'display-color-p) (display-color-p))

20 (and (fboundp 'device-class)

21 (eq 'color (device-class (selected-device))))

22 window-system) ; falls down lazy check..

23 "Current display's capability of expressing colors.")

25 (defvar YaTeX-japan

26 (or (boundp 'NEMACS)

27 (boundp 'MULE)

28 (and (boundp 'current-language-environment)

29 (string-match "[Jj]apanese" current-language-environment)))

30 "Whether yatex mode is running on Japanese environment or not.")

32 ;; autoload from yahtml.el

33 (autoload 'yahtml-inner-environment-but "yahtml" "yahtml internal func." t)

35 (defvar YaTeX-kanji-code-alist

36 (cond

37 ((boundp '*junet*)

38 (list '(0 . *noconv*)

39 (cons

40 1

41 (cond

42 (YaTeX-dos (if (boundp '*sjis-dos*) *sjis-dos* *sjis*dos))

43 (YaTeX-macos (if (boundp '*sjis-mac*) *sjis-mac* *sjis*mac))

44 (t *sjis*)))

45 '(2 . *junet*) '(3 . *euc-japan*)))

46 (YaTeX-emacs-20

47 ;;(cdr-safe(assq 'coding-system (assoc "Japanese" language-info-alist)))

48 (list '(0 . no-conversion)

49 (cons

50 1 (cond (YaTeX-dos 'shift_jis-dos)

51 (YaTeX-macos 'shift_jis-mac)

52 ((member 'shift_jis (coding-system-list)) 'shift_jis-unix)

53 (t 'sjis)))

54 '(2 . iso-2022-jp-unix)

55 '(3 . euc-jp-unix))))

56 "Kanji-code expression translation table.")

57 (defvar YaTeX-inhibit-prefix-letter nil

58 "*T for changing key definitions from [prefix] Letter to [prefix] C-Letter.")

60 (defvar YaTeX-no-begend-shortcut nil

61 "*T for disabling shortcut of begin-type completion, [prefix] b d, etc.")

63 (defvar YaTeX-default-pop-window-height 10

64 "Default typesetting buffer height.

65 If integer, sets the window-height of typesetting buffer.

66 If string, sets the percentage of it.

67 If nil, use default pop-to-buffer.")

69 (defvar YaTeX-create-file-prefix-g nil

70 "*Non-nil creates new file when [prefix] g on \\include{foo}.")

72 (defvar YaTeX-nervous t

73 "*If you are nervous about maintenance of yatexrc, set this value to T.

74 And you will have the local dictionary.")

76 (defvar YaTeX-use-italic-bold (string< "20" emacs-version)

77 "*Non-nil tries to find italic/bold fontset.

78 This variable is effective when font-lock is used.

79 \it, \bf 内部での日本語が□になってしまう場合はこれをnilにして下さい。")

81 ;----------- work variables ----------------------------------------

82 (defvar YaTeX-typesetting-mode-map nil

83 "Keymap used in YaTeX typesetting buffer")

85 (if YaTeX-typesetting-mode-map nil

86 (setq YaTeX-typesetting-mode-map (make-keymap))

87 ;(suppress-keymap YaTeX-typesetting-mode-map t)

88 (define-key YaTeX-typesetting-mode-map " " 'YaTeX-jump-error-line)

89 (define-key YaTeX-typesetting-mode-map "\C-m" 'YaTeX-send-string)

90 (define-key YaTeX-typesetting-mode-map "1" 'delete-other-windows)

91 (define-key YaTeX-typesetting-mode-map "0" 'delete-window)

92 (define-key YaTeX-typesetting-mode-map "q" 'delete-window))

94 (defvar YaTeX-parent-file nil

95 "*Main LaTeX source file name used when %#! expression doesn't exist.")

96 (make-variable-buffer-local 'YaTeX-parent-file)

98 ;---------- Define default key bindings on YaTeX mode map ----------

99 ;;;###autoload

100 (defun YaTeX-define-key (key binding &optional map)

101 "Define key on YaTeX-prefix-map."

102 (if YaTeX-inhibit-prefix-letter

103 (let ((c (aref key 0)))

104 (cond

105 ((and (>= c ?a) (<= c ?z)) (aset key 0 (1+ (- c ?a))))

106 ((and (>= c ?A) (<= c ?Z) (numberp YaTeX-inhibit-prefix-letter))

107 (aset key 0 (1+ (- c ?A))))

108 (t nil))))

109 (define-key (or map YaTeX-prefix-map) key binding))

110

111 ;;;###autoload

112 (defun YaTeX-local-table-symbol (symbol)

113 "Return the lisp symbol which keeps local completion table of SYMBOL."

114 (intern (concat "YaTeX$"

115 default-directory

116 (symbol-name symbol))))

117

118 ;;;###autoload

119 (defun YaTeX-sync-local-table (symbol)

120 "Synchronize local variable SYMBOL.

121 Copy its corresponding directory dependent completion table to SYMBOL."

122 (if (boundp (YaTeX-local-table-symbol symbol))

123 (set symbol (symbol-value (YaTeX-local-table-symbol symbol)))))

124

125 (defvar YaTeX-user-table-is-read nil

126 "Flag that means whether user completion table has been read or not.")

127 ;;;###autoload

128 (defun YaTeX-read-user-completion-table (&optional forcetoread)

129 "Append user completion table of LaTeX macros"

130 (let*((user-table (expand-file-name YaTeX-user-completion-table))

131 (local-table (expand-file-name (file-name-nondirectory user-table)))

132 var localvar localbuf (curbuf (current-buffer)) sexp)

133 (if YaTeX-user-table-is-read nil

134 (message "Loading user completion table")

135 (if (file-exists-p user-table) (load-file user-table)

136 (message "Welcome to the field of YaTeX. I'm glad to see you!")))

137 (setq YaTeX-user-table-is-read t)

138 (cond

139 ((file-exists-p local-table)

140 (set-buffer (setq localbuf (find-file-noselect local-table)))

141 (widen)

142 (goto-char (point-min))

143 (while (re-search-forward "(setq \$[^ ]+\$" nil t)

144 (setq var (intern (buffer-substring

145 (match-beginning 1) (match-end 1)))

146 localvar (YaTeX-local-table-symbol var))

147 (goto-char (match-beginning 0))

148 (setq sexp (buffer-substring (point)

149 (progn (forward-sexp) (point))))

150 (set-buffer curbuf)

151 (or (assq var (buffer-local-variables)) (make-local-variable var))

152 (eval (read sexp))

153 (or (and (boundp localvar)

154 (symbol-value localvar)

155 (not forcetoread))

156 (set localvar (symbol-value var)))

157 (set-buffer localbuf))

158 (kill-buffer localbuf)))

159 (set-buffer curbuf)))

160

161 ;;;###autoload

162 (defun YaTeX-reload-dictionary ()

163 "Reload local dictionary.

164 Use this function after editing ./.yatexrc."

165 (interactive)

166 (let ((YaTeX-user-table-is-read nil))

167 (YaTeX-read-user-completion-table t)))

168

169 ;;;###autoload

170 (defun YaTeX-lookup-table (word type)

171 "Lookup WORD in completion table whose type is TYPE.

172 This function refers the symbol tmp-TYPE-table, user-TYPE-table, TYPE-table.

173 Typically, TYPE is one of 'env, 'section, 'fontsize, 'singlecmd."

174 (if (symbolp type) (setq type (symbol-name type)))

175 (or (assoc word (symbol-value (intern (concat "tmp-" type "-table"))))

176 (assoc word (symbol-value (intern (concat "user-" type "-table"))))

177 (assoc word (symbol-value (intern (concat type "-table"))))))

178

179 ;;;###autoload

180 (defun YaTeX-update-table (vallist default-table user-table local-table)

181 "Update completion table if the car of VALLIST is not in current tables.

182 Second argument DEFAULT-TABLE is the quoted symbol of default completion

183 table, third argument USER-TABLE is user table which will be saved in

184 YaTeX-user-completion-table, fourth argument LOCAL-TABLE should have the

185 completion which is valid during current Emacs's session. If you

186 want to make LOCAL-TABLE valid longer span (but restrict in this directory)

187 create the file in current directory which has the same name with

188 YaTeX-user-completion-table."

189 (let ((car-v (car vallist)) key answer

190 (file (file-name-nondirectory YaTeX-user-completion-table)))

191 (cond

192 ((assoc car-v (symbol-value default-table))

193 nil) ;Nothing to do

194 ((setq key (assoc car-v (symbol-value user-table)))

195 (if (equal (cdr vallist) (cdr key)) nil

196 ;; if association hits, but contents differ.

197 (message

198 "%s's attributes turned into %s" (car vallist) (cdr vallist))

199 (set user-table (delq key (symbol-value user-table)))

200 (set user-table (cons vallist (symbol-value user-table)))

201 (YaTeX-update-dictionary

202 YaTeX-user-completion-table user-table "user")))

203 ((setq key (assoc car-v (symbol-value local-table)))

204 (if (equal (cdr vallist) (cdr key)) nil

205 (message

206 "%s's attributes turned into %s" (car vallist) (cdr vallist))

207 (set local-table (delq key (symbol-value local-table)))

208 (set local-table (cons vallist (symbol-value local-table)))

209 (set (YaTeX-local-table-symbol local-table) (symbol-value local-table))

210 (YaTeX-update-dictionary file local-table)))

211 ;; All of above cases, there are some completion in tables.

212 ;; Then update tables.

213 (t

214 (if (not YaTeX-nervous)

215 (setq answer "u")

216 (message

217 (cond

218 (YaTeX-japan

219 "`%s'の登録先: U)ユーザ辞書 L)ローカル辞書 N)メモリ D)しない")

220 (t

221 "Register `%s' into: U)serDic L)ocalDic N)one D)iscard"))

222 (if (> (length car-v) 23)

223 (concat (substring car-v 0 10) "..." (substring car-v -9))

224 car-v))

225 (setq answer (char-to-string (read-char))))

226 (cond

227 ((string-match answer "uy")

228 (set user-table (cons vallist (symbol-value user-table)))

229 (YaTeX-update-dictionary YaTeX-user-completion-table user-table "user")

230 )

231 ((string-match answer "tl")

232 (set local-table (cons vallist (symbol-value local-table)))

233 (set (YaTeX-local-table-symbol local-table) (symbol-value local-table))

234 (YaTeX-update-dictionary file local-table))

235 ((string-match answer "d") nil) ;discard it

236 (t (set default-table

237 (cons vallist (symbol-value default-table)))))))))

238

239 ;;;###autoload

240 (defun YaTeX-cplread-with-learning

241 (prom default-table user-table local-table

242 &optional pred reqmatch init hsym)

243 "Completing read with learning.

244 Do a completing read with prompt PROM. Completion table is what

245 DEFAULT-TABLE, USER-TABLE, LOCAL table are appended in reverse order.

246 Note that these tables are passed by the symbol.

247 Optional arguments PRED, REQMATH and INIT are passed to completing-read

248 as its arguments PREDICATE, REQUIRE-MATCH and INITIAL-INPUT respectively.

249 If optional 8th argument HSYM, history symbol, is passed, use it as

250 history list variable."

251 (YaTeX-sync-local-table local-table)

252 (let*((table (append (symbol-value local-table)

253 (symbol-value user-table)

254 (symbol-value default-table)))

255 (word (completing-read-with-history

256 prom table pred reqmatch init hsym)))

257 (if (and (string< "" word) (not (assoc word table)))

258 (YaTeX-update-table (list word) default-table user-table local-table))

259 word))

260

261 ;;;###autoload

262 (defun YaTeX-update-dictionary (file symbol &optional type)

263 (let ((local-table-buf (find-file-noselect file))

264 (name (symbol-name symbol))

265 (value (symbol-value symbol)))

266 (save-excursion

267 (message "Updating %s dictionary..." (or type "local"))

268 (set-buffer local-table-buf)

269 (goto-char (point-max))

270 (search-backward (concat "(setq " name) nil t)

271 (delete-region (point) (progn (forward-sexp) (point)))

272 (delete-blank-lines)

273 (insert "(setq " name " '(\n")

274 (mapcar '(lambda (s)

275 (insert (format "%s\n" (prin1-to-string s))))

276 value)

277 (insert "))\n\n")

278 (delete-blank-lines)

279 (basic-save-buffer)

280 (kill-buffer local-table-buf)

281 (message "Updating %s dictionary...Done" (or type "local")))))

282

283 ;;;###autoload

284 (defun YaTeX-define-begend-key-normal (key env &optional map)

285 "Define short cut YaTeX-make-begin-end key."

286 (YaTeX-define-key

287 key

288 (list 'lambda '(arg) '(interactive "P")

289 (list 'YaTeX-insert-begin-end env 'arg))

290 map))

291

292 ;;;###autoload

293 (defun YaTeX-define-begend-region-key (key env &optional map)

294 "Define short cut YaTeX-make-begin-end-region key."

295 (YaTeX-define-key key (list 'lambda nil '(interactive)

296 (list 'YaTeX-insert-begin-end env t)) map))

297

298 ;;;###autoload

299 (defun YaTeX-define-begend-key (key env &optional map)

300 "Define short cut key for begin type completion both for normal

301 and region mode. To customize YaTeX, user should use this function."

302 (YaTeX-define-begend-key-normal key env map)

303 (if YaTeX-inhibit-prefix-letter nil

304 (YaTeX-define-begend-region-key

305 (concat (upcase (substring key 0 1)) (substring key 1)) env)))

306

307 ;;;###autoload

308 (defun YaTeX-search-active-forward (string cmntrx &optional bound err cnt func)

309 "Search STRING which is not commented out by CMNTRX.

310 Optional arguments after BOUND, ERR, CNT are passed literally to search-forward

311 or search-backward.

312 Optional sixth argument FUNC changes search-function."

313 (let ((sfunc (or func 'search-forward)) found md)

314 (while (and (prog1

315 (setq found (funcall sfunc string bound err cnt))

316 (setq md (match-data)))

317 (or

318 (and (eq major-mode 'yatex-mode)

319 (YaTeX-in-verb-p (match-beginning 0)))

320 (save-excursion

321 (goto-char (match-beginning 0))

322 (beginning-of-line)

323 (re-search-forward cmntrx (match-beginning 0) t)))))

324 (store-match-data md)

325 found))

326

327 (defun YaTeX-re-search-active-forward (regexp cmntrx &optional bound err cnt)

328 "Search REGEXP backward which is not commented out by regexp CMNTRX.

329 See also YaTeX-search-active-forward."

330 (YaTeX-search-active-forward regexp cmntrx bound err cnt 're-search-forward))

331

332 (defun YaTeX-search-active-backward (string cmntrx &optional bound err cnt)

333 "Search STRING backward which is not commented out by regexp CMNTRX.

334 See also YaTeX-search-active-forward."

335 (YaTeX-search-active-forward string cmntrx bound err cnt 'search-backward))

336

337 (defun YaTeX-re-search-active-backward (regexp cmntrx &optional bound err cnt)

338 "Search REGEXP backward which is not commented out by regexp CMNTRX.

339 See also YaTeX-search-active-forward."

340 (YaTeX-search-active-forward

341 regexp cmntrx bound err cnt 're-search-backward))

342

343 ;;;###autoload

344 (defun YaTeX-switch-to-buffer (file &optional setbuf)

345 "Switch to buffer if buffer exists, find file if not.

346 Optional second arg SETBUF t make use set-buffer instead of switch-to-buffer."

347 (interactive "Fswitch to file: ")

348 (if (bufferp file)

349 (setq file (buffer-file-name file))

350 (and (string-match "^[^/].*/" file)

351 (eq major-mode 'yatex-mode)

352 YaTeX-search-file-from-top-directory

353 (save-excursion

354 (YaTeX-visit-main t)

355 (setq file (expand-file-name file)))))

356 (let (buf (hilit-auto-highlight (not setbuf)))

357 (cond

358 ((setq buf (get-file-buffer file))

359 (funcall (if setbuf 'set-buffer 'switch-to-buffer)

360 (get-file-buffer file))

361 buf)

362 ((or YaTeX-create-file-prefix-g (file-exists-p file))

363 (or ;find-file returns nil but set current-buffer...

364 (if setbuf (set-buffer (find-file-noselect file))

365 (find-file file))

366 (current-buffer)))

367 (t (message "%s was not found in this directory." file)

368 nil))))

369

370 ;;;###autoload

371 (defun YaTeX-switch-to-buffer-other-window (file)

372 "Switch to buffer if buffer exists, find file if not."

373 (interactive "Fswitch to file: ")

374 (and (eq major-mode 'yatex-mode)

375 (stringp file)

376 (string-match "^[^/].*/" file)

377 YaTeX-search-file-from-top-directory

378 (save-excursion

379 (YaTeX-visit-main t)

380 (setq file (expand-file-name file))))

381 (if (bufferp file) (setq file (buffer-file-name file)))

382 (cond

383 ((get-file-buffer file)

384 (switch-to-buffer-other-window (get-file-buffer file))

385 t)

386 ((or YaTeX-create-file-prefix-g (file-exists-p file))

387 (find-file-other-window file) t)

388 (t (message "%s was not found in this directory." file)

389 nil)))

390

391 (defun YaTeX-get-file-buffer (file)

392 "Return the FILE's buffer.

393 Base directory is that of main file or current directory."

394 (let (dir main (cdir default-directory))

395 (or (and (eq major-mode 'yatex-mode)

396 YaTeX-search-file-from-top-directory

397 (save-excursion

398 (YaTeX-visit-main t)

399 (get-file-buffer file)))

400 (get-file-buffer file))))

401

402 (defun YaTeX-replace-format-sub (string format repl)

403 (let ((beg (or (string-match (concat "^\$%" format "\$") string)

404 (string-match (concat "[^%]\$%" format "\$") string)))

405 (len (length format)))

406 (if (null beg) string ;no conversion

407 (concat

408 (substring string 0 (match-beginning 1)) (or repl "")

409 (substring string (match-end 1))))))

410

411 ;;;###autoload

412 (defun YaTeX-replace-format (string format repl)

413 "In STRING, replace first appearance of FORMAT to REPL as if

414 function `format' does. FORMAT does not contain `%'"

415 (let ((ans string))

416 (while (not (string=

417 ans (setq string (YaTeX-replace-format-sub ans format repl))))

418 (setq ans string))

419 string))

420

421 ;;;###autoload

422 (defun YaTeX-replace-formats (string replace-list)

423 (let ((list replace-list))

424 (while list

425 (setq string (YaTeX-replace-format

426 string (car (car list)) (cdr (car list)))

427 list (cdr list)))

428 string))

429

430 ;;;###autoload

431 (defun YaTeX-replace-format-args (string &rest args)

432 "Translate the argument mark #1, #2, ... #n in the STRING into the

433 corresponding real arguments ARGS."

434 (let ((argp 1))

435 (while args

436 (setq string

437 (YaTeX-replace-format string (int-to-string argp) (car args)))

438 (setq args (cdr args) argp (1+ argp))))

439 string)

440

441 ;;;###autoload

442 (defun rindex (string char)

443 (let ((pos (1- (length string)))(index -1))

444 (while (>= pos 0)

445 (cond

446 ((= (aref string pos) char)

447 (setq index pos) (setq pos -1))

448 (t (setq pos (1- pos))))

449 )

450 index))

451

452 ;;;###autoload

453 (defun point-beginning-of-line ()

454 (save-excursion (beginning-of-line)(point)))

455

456 ;;;###autoload

457 (defun point-end-of-line ()

458 (save-excursion (end-of-line)(point)))

459

460

461 ;;;###autoload

462 (defun YaTeX-showup-buffer (buffer &optional func select)

463 "Make BUFFER show up in certain window (but current window)

464 that gives the maximum value by the FUNC. FUNC should take an argument

465 of its window object. Non-nil for optional third argument SELECT selects

466 that window. This function never selects minibuffer window."

467 (or (and (if (and YaTeX-emacs-19 select)

468 (get-buffer-window buffer t)

469 (get-buffer-window buffer))

470 (progn

471 (if select

472 (goto-buffer-window buffer))

473 t))

474 (let ((window (selected-window))

475 (wlist (YaTeX-window-list)) win w (x 0))

476 (cond

477 ((> (length wlist) 2)

478 (if func

479 (while wlist

480 (setq w (car wlist))

481 (if (and (not (eq window w))

482 (> (funcall func w) x))

483 (setq win w x (funcall func w)))

484 (setq wlist (cdr wlist)))

485 (setq win (get-lru-window)))

486 (select-window win)

487 (switch-to-buffer buffer)

488 (or select (select-window window)))

489 ((= (length wlist) 2)

490 ;(other-window 1);This does not work properly on Emacs-19

491 (select-window (get-lru-window))

492 (switch-to-buffer buffer)

493 (or select (select-window window)))

494 (t ;if one-window

495 (cond

496 ((and YaTeX-emacs-19 (get-buffer-window buffer t))

497 nil) ;if found in other frame

498 (YaTeX-default-pop-window-height

499 (split-window-calculate-height YaTeX-default-pop-window-height)

500 ;;(pop-to-buffer buffer) ;damn! emacs-19.30

501 (select-window (next-window nil 1))

502 (switch-to-buffer (get-buffer-create buffer))

503 (or select (select-window window)))

504 (t nil)))

505 ))))

506

507 (cond

508 ((fboundp 'screen-height)

509 (fset 'YaTeX-screen-height 'screen-height)

510 (fset 'YaTeX-screen-width 'screen-width))

511 ((fboundp 'frame-height)

512 (fset 'YaTeX-screen-height 'frame-height)

513 (fset 'YaTeX-screen-width 'frame-width))

514 (t (error "I don't know how to run windows.el on this Emacs...")))

515

516 ;;;###autoload

517 (defun split-window-calculate-height (height)

518 "Split current window wight specified HEIGHT.

519 If HEIGHT is number, make a new window that has HEIGHT lines.

520 If HEIGHT is string, make a new window that occupies HEIGT % of screen height.

521 Otherwise split window conventionally."

522 (if (one-window-p t)

523 (split-window

524 (selected-window)

525 (max

526 (min

527 (- (YaTeX-screen-height)

528 (if (numberp height)

529 (+ height 2)

530 (/ (* (YaTeX-screen-height)

531 (string-to-int height))

532 100)))

533 (- (YaTeX-screen-height) window-min-height 1))

534 window-min-height))))

535

536 ;;;###autoload

537 (defun YaTeX-window-list ()

538 (let*((curw (selected-window)) (win curw) (wlist (list curw)))

539 (while (not (eq curw (setq win (next-window win))))

540 (or (eq win (minibuffer-window))

541 (setq wlist (cons win wlist))))

542 wlist))

543

544 (if YaTeX-emacs-21

545 ;; Emacs-21's next-window returns other frame's window even if called

546 ;; with argument ALL-FRAMES nil, when called from minibuffer context.

547 ;; Therefore, check frame identity here.

548 (defun YaTeX-window-list ()

549 (let*((curw (selected-window)) (win curw) (wlist (list curw))

550 (curf (window-frame curw)))

551 (while (and (not (eq curw (setq win (next-window win))))

552 (eq curf (window-frame win)))

553 (or (eq win (minibuffer-window))

554 (setq wlist (cons win wlist))))

555 wlist)))

556

557 ;;;###autoload

558 (defun substitute-all-key-definition (olddef newdef keymap)

559 "Replace recursively OLDDEF with NEWDEF for any keys in KEYMAP now

560 defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF

561 where ever it appears."

562 (if YaTeX-emacs-19

563 (substitute-key-definition olddef newdef keymap global-map)

564 (mapcar

565 (function (lambda (key) (define-key keymap key newdef)))

566 (where-is-internal olddef keymap))))

567

568 ;;;###autoload

569 (defun YaTeX-match-string (n &optional m)

570 "Return (buffer-substring (match-beginning n) (match-beginning m))."

571 (if (match-beginning n)

572 (buffer-substring (match-beginning n)

573 (match-end (or m n)))))

574

575 ;;;###autoload

576 (defun YaTeX-minibuffer-complete ()

577 "Complete in minibuffer.

578 If the symbol 'delim is bound and is string, its value is assumed to be

579 the character class of delimiters. Completion will be performed on

580 the last field separated by those delimiters.

581 If the symbol 'quick is bound and is 't, when the try-completion results

582 in t, exit minibuffer immediately."

583 (interactive)

584 (save-restriction

585 (narrow-to-region

586 (if (fboundp 'field-beginning) (field-beginning (point-max)) (point-min))

587 (point-max))

588 (let ((md (match-data)) beg word compl

589 (quick (and (boundp 'quick) (eq quick t)))

590 (displist ;function to display completion-list

591 (function

592 (lambda ()

593 (with-output-to-temp-buffer "*Completions*"

594 (display-completion-list

595 (all-completions word minibuffer-completion-table)))))))

596 (setq beg (if (and (boundp 'delim) (stringp delim))

597 (save-excursion

598 (skip-chars-backward (concat "^" delim))

599 (point))

600 (point-min))

601 word (buffer-substring beg (point-max))

602 compl (try-completion word minibuffer-completion-table))

603 (cond

604 ((eq compl t)

605 (if quick (exit-minibuffer)

606 (let ((p (point)) (max (point-max)))

607 (unwind-protect

608 (progn

609 (goto-char max)

610 (insert " [Sole completion]")

611 (goto-char p)

612 (sit-for 1))

613 (delete-region max (point-max))

614 (goto-char p)))))

615 ((eq compl nil)

616 (ding)

617 (save-excursion

618 (let (p)

619 (unwind-protect

620 (progn

621 (goto-char (setq p (point-max)))

622 (insert " [No match]")

623 (goto-char p)

624 (sit-for 2))

625 (delete-region p (point-max))))))

626 ((string= compl word)

627 (funcall displist))

628 (t (delete-region beg (point-max))

629 (insert compl)

630 (if quick

631 (if (eq (try-completion compl minibuffer-completion-table) t)

632 (exit-minibuffer)

633 (funcall displist)))))

634 (store-match-data md))))

635

636 (defun YaTeX-minibuffer-quick-complete ()

637 "Set 'quick to 't and call YaTeX-minibuffer-complete.

638 See documentation of YaTeX-minibuffer-complete."

639 (interactive)

640 (let ((quick t))

641 (self-insert-command 1)

642 (YaTeX-minibuffer-complete)))

643

644 (defun foreach-buffers (pattern job)

645 "For each buffer which matches with PATTERN, do JOB."

646 (let ((list (buffer-list)))

647 (save-excursion

648 (while list

649 (set-buffer (car list))

650 (if (or (and (stringp pattern)

651 (buffer-file-name)

652 (string-match pattern (buffer-file-name)))

653 (and (symbolp pattern) major-mode (eq major-mode pattern)))

654 (eval job))

655 (setq list (cdr list))))))

656

657 (defun goto-buffer-window (buffer)

658 "Select window which is bound to BUFFER.

659 If no such window exist, switch to buffer BUFFER."

660 (interactive "BGoto buffer: ")

661 (if (stringp buffer)

662 (setq buffer (or (get-file-buffer buffer) (get-buffer buffer))))

663 (if (get-buffer buffer)

664 (cond

665 ((get-buffer-window buffer)

666 (select-window (get-buffer-window buffer)))

667 ((and YaTeX-emacs-19 (get-buffer-window buffer t))

668 (let*((win (get-buffer-window buffer t))

669 (frame (window-frame win)))

670 (select-frame frame)

671 (raise-frame frame)

672 (focus-frame frame)

673 (select-window win)

674 (set-mouse-position frame 0 0)

675 (and (featurep 'windows) (fboundp 'win:adjust-window)

676 (win:adjust-window))))

677 ((and (featurep 'windows) (fboundp 'win:get-buffer-window)

678 (let ((w (win:get-buffer-window buffer)))

679 (and w (win:switch-window w))))

680 (select-window (get-buffer-window buffer)))

681 (t (switch-to-buffer buffer)))))

682

683 ;; Here starts the functions which support gmhist-vs-Emacs19 compatible

684 ;; reading with history.

685 ;;;###autoload

686 (defun completing-read-with-history

687 (prompt table &optional predicate must-match initial hsym)

688 "Completing read with general history: gmhist, Emacs-19."

689 (let ((minibuffer-history

690 (or (symbol-value hsym)

691 (and (boundp 'minibuffer-history) minibuffer-history)))

692 (minibuffer-history-symbol (or hsym 'minibuffer-history)))

693 (prog1

694 (if (fboundp 'completing-read-with-history-in)

695 (completing-read-with-history-in

696 minibuffer-history-symbol prompt table predicate must-match initial)

697 (completing-read prompt table predicate must-match initial))

698 (if (and YaTeX-emacs-19 hsym) (set hsym minibuffer-history)))))

699

700 ;;;###autoload

701 (defun read-from-minibuffer-with-history (prompt &optional init map read hsym)

702 "Read from minibuffer with general history: gmhist, Emacs-19."

703 (cond

704 (YaTeX-emacs-19

705 (read-from-minibuffer prompt init map read hsym))

706 (t

707 (let ((minibuffer-history-symbol hsym))

708 (read-from-minibuffer prompt init map read)))))

709

710 ;;;###autoload

711 (defun read-string-with-history (prompt &optional init hsym)

712 "Read string with history: gmhist(Emacs-18) and Emacs-19."

713 (cond

714 (YaTeX-emacs-19

715 (read-from-minibuffer prompt init minibuffer-local-map nil hsym))

716 ((featurep 'gmhist-mh)

717 (read-with-history-in hsym prompt init))

718 (t (read-string prompt init))))

719

720 ;;;###autoload

721 (fset 'YaTeX-rassoc

722 (if (and nil (fboundp 'rassoc) (subrp (symbol-function 'rassoc)))

723 (symbol-function 'rassoc)

724 (function

725 (lambda (key list)

726 (let ((l list))

727 (catch 'found

728 (while l

729 (if (equal key (cdr (car l)))

730 (throw 'found (car l)))

731 (setq l (cdr l)))))))))

732

733 (defun YaTeX-insert-file-contents (file visit &optional beg end)

734 (cond

735 ((and (string< "19" emacs-version) (not (featurep 'xemacs)))

736 (insert-file-contents file visit beg end))

737 ((string-match "unix\\|linux" (symbol-name system-type))

738 (let ((default-process-coding-system

739 (and (boundp '*noconv*) (list '*noconv*)))

740 (file-coding-system (and (boundp '*noconv*) '*noconv*))

741 kanji-fileio-code

742 (default-process-kanji-code 0))

743 (call-process shell-file-name file (current-buffer) nil

744 (or (and (boundp 'shell-command-option)

745 shell-command-option)

746 "-c")

747 (format "dd bs=1 count=%d | tail -c +%d" end beg))))

748 (t (insert-file-contents file))))

749

750 (defun YaTeX-split-string (str &optional sep null)

751 "Split string STR by every occurrence of SEP(regexp).

752 If the optional second argument SEP is nil, it defaults to \"[ \f\t\n\r\v]+\".

753 Do not include null string by default. Non-nil for optional third argument

754 NULL includes null string in a list."

755 (let ((sep (or sep "[ \f\t\n\r\v]+"))

756 list m)

757 (while str

758 (if (setq m (string-match sep str))

759 (progn

760 (if (or (> m 0) null)

761 (setq list (cons (substring str 0 m) list)))

762 (setq str (substring str (match-end 0))))

763 (if (or null (string< "" str))

764 (setq list (cons str list)))

765 (setq str nil)))

766 (nreverse list)))

767

768 ;;;###autoload

769 (defun YaTeX-delete1 (elt list)

770 "Delete"

771 (let (e)

772 (while (setq e (YaTeX-member elt list))

773 (setq list (delq (car e) list))))

774 list)

775 (if (fboundp 'delete)

776 (fset 'YaTeX-delete (symbol-function 'delete))

777 (fset 'YaTeX-delete (symbol-function 'YaTeX-delete1)))

778

779 (defun YaTeX-member1 (elt list)

780 (catch 'found

781 (while list

782 (if (equal elt (car list))

783 (throw 'found list))

784 (setq list (cdr list)))))

785

786 (if (and (fboundp 'member) (subrp (symbol-function 'member)))

787 (fset 'YaTeX-member (symbol-function 'member))

788 (fset 'YaTeX-member (symbol-function 'YaTeX-member1)))

789

790 ;;;

791 ;; Interface function for windows.el

792 ;;;

793 ;;;###autoload

794 (defun YaTeX-switch-to-window ()

795 "Switch to windows.el's window decided by last pressed key."

796 (interactive)

797 (or (featurep 'windows) (error "Why don't you use `windows.el'?"))

798 (win-switch-to-window 1 (- last-command-char win:base-key)))

799

800 ;;;###autoload

801 (defun YaTeX-reindent (col)

802 "Remove current indentation and reindento to COL column."

803 (save-excursion

804 (beginning-of-line)

805 (skip-chars-forward " \t")

806 (if (/= col (current-column))

807 (progn

808 (delete-region (point) (progn (beginning-of-line) (point)))

809 (indent-to col))))

810 (skip-chars-forward " \t" (point-end-of-line)))

811

812 (defun YaTeX-inner-environment (&optional quick)

813 "Return current inner-most environment.

814 Non-nil for optional argument QUICK restricts search bound to most

815 recent sectioning command. Matching point is stored to property 'point

816 of 'YaTeX-inner-environment, which can be referred by

817 (get 'YaTeX-inner-environment 'point)."

818 (put 'YaTeX-inner-environment 'point (point-min))

819 (put 'YaTeX-inner-environment 'indent 0)

820 (let*((nest 0)

821 (beg (YaTeX-replace-format-args

822 (regexp-quote YaTeX-struct-begin)

823 ;YaTeX-struct-begin ;=== TENTATIVE!! ==

824 YaTeX-struct-name-regexp

825 (if (eq major-mode 'yahtml-mode) "\\s *.*" "")

826 ""))

827 (end (YaTeX-replace-format-args

828 (regexp-quote YaTeX-struct-end)

829 YaTeX-struct-name-regexp "" ""))

830 (begend (concat "\$" beg "\$\\|\$" end "\$"))

831 bound m0

832 (htmlp (eq major-mode 'yahtml-mode))

833 (open

834 (concat "^" (or (cdr (assq major-mode '((yahtml-mode . "<")))) "{")))

835 (close

836 (concat "^"

837 (or (cdr(assq major-mode '((yahtml-mode . "\n\t >")))) "}"))))

838 (save-excursion

839 (if quick

840 (setq bound

841 (save-excursion

842 (if htmlp

843 ;;(re-search-backward YaTeX-sectioning-regexp nil 1)

844 ;;(goto-char (point-min)) ;Is this enough? 97/6/26

845 (re-search-backward yahtml-indentation-boundary nil 1)

846 (YaTeX-re-search-active-backward

847 (concat YaTeX-ec-regexp

848 "\$" YaTeX-sectioning-regexp "\$\\*?{")

849 YaTeX-comment-prefix nil 1))

850 (or (bobp) (end-of-line))

851 (point))))

852 (if (catch 'begin

853 (if (and (numberp bound) (< (point) bound)) (throw 'begin nil))

854 (while (YaTeX-re-search-active-backward

855 begend YaTeX-comment-prefix bound t)

856 (setq m0 (match-beginning 0))

857 (if (looking-at end) ;;(match-beginning 2)

858 (setq nest (1+ nest))

859 (setq nest (1- nest)))

860 (if (< nest 0)

861 (progn

862 (put 'YaTeX-inner-environment 'point m0)

863 (goto-char m0)

864 (put 'YaTeX-inner-environment 'indent (current-column))

865 (throw 'begin t)))))

866 (buffer-substring

867 (progn (skip-chars-forward open) (1+ (point)))

868 (progn (skip-chars-forward close) (point)))))))

869

870 (defun YaTeX-goto-corresponding-environment (&optional allow-mismatch noerr)

871 "Go to corresponding begin/end enclosure.

872 Optional argument ALLOW-MISMATCH allows mismatch open/clese. Use this

873 for \left(, \right).

874 Optional third argument NOERR causes no error for unballanced environment."

875 (interactive)

876 (if (not (YaTeX-on-begin-end-p)) nil

877 (let ((p (match-end 0)) b0 b1 env (nest 0) regexp re-s (op (point))

878 (m0 (match-beginning 0)) ;whole matching

879 (m1 (match-beginning 1)) ;environment in \begin{}

880 (m2 (match-beginning 2)) ;environment in \end{}

881 (m3 (match-beginning 3))) ;environment in \[ \] 

882 ;(setq env (regexp-quote (buffer-substring p (match-beginning 0))))

883 (if (cond

884 (m1 ;if begin{xxx}

885 (setq env

886 (if allow-mismatch YaTeX-struct-name-regexp

887 (regexp-quote (buffer-substring m1 (match-end 1)))))

888 ; (setq regexp (concat "\$\\\\end{" env "}\$\\|"

889 ; "\$\\\\begin{" env "}\$"))

890 (setq regexp

891 (concat

892 "\\("

893 (YaTeX-replace-format-args

894 (regexp-quote YaTeX-struct-end) env "" "")

895 "\\)\\|\\("

896 (YaTeX-replace-format-args

897 (regexp-quote YaTeX-struct-begin) env "" "")

898 "\\)"))

899 (setq re-s 're-search-forward))

900 (m2 ;if end{xxx}

901 (setq env

902 (if allow-mismatch YaTeX-struct-name-regexp

903 (regexp-quote (buffer-substring m2 (match-end 2)))))

904 ; (setq regexp (concat "\$\\\\begin{" env "}\$\\|"

905 ; "\$\\\\end{" env "}\$"))

906 (setq regexp

907 (concat

908 "\\("

909 (YaTeX-replace-format-args

910 (regexp-quote YaTeX-struct-begin) env "" "")

911 "\\)\\|\\("

912 (YaTeX-replace-format-args

913 (regexp-quote YaTeX-struct-end) env "" "")

914 "\\)"))

915 (setq re-s 're-search-backward))

916 (m3 ;math environment

917 (setq env (char-after (1+ m3))

918 regexp (format "\$%s%s\$\\|\$%s%s\$"

919 YaTeX-ec-regexp

920 (regexp-quote

921 (cdr (assq env '((?( . ")") (?) . "(")

922 (?[ . "]") (?] . "[")))))

923 YaTeX-ec-regexp

924 (regexp-quote (char-to-string env)))

925 re-s (if (memq env '(?\( ?\[))

926 're-search-forward

927 're-search-backward)))

928 (t (if noerr nil (error "Corresponding environment not found."))))

929 (progn

930 (while (and (>= nest 0) (funcall re-s regexp nil t))

931 (setq b0 (match-beginning 0) b1 (match-beginning 1))

932 (if (or (equal b0 m0)

933 (YaTeX-literal-p b0))

934 nil

935 (setq nest (if (equal b0 b1)

936 (1- nest) (1+ nest)))))

937 (if (< nest 0)

938 (goto-char (match-beginning 0)) ;found.

939 (goto-char op)

940 (funcall

941 (if noerr 'message 'error)

942 "Corresponding environment `%s' not found." env)

943 (sit-for 1)

944 nil))))))

945

946 (defun YaTeX-end-environment ()

947 "Close opening environment"

948 (interactive)

949 (let ((env (YaTeX-inner-environment)))

950 (if (not env) (error "No premature environment")

951 (save-excursion

952 (if (YaTeX-search-active-forward

953 (YaTeX-replace-format-args YaTeX-struct-end env "" "")

954 YaTeX-comment-prefix nil t)

955 (if (y-or-n-p

956 (concat "Environment `" env

957 "' may be already closed. Force close?"))

958 nil

959 (error "end environment aborted."))))

960 (message "") ;Erase (y or n) message.

961 (YaTeX-insert-struc 'end env)

962 (save-excursion

963 (goto-char (or (get 'YaTeX-inner-environment 'point) (match-end 0)))

964 (if (pos-visible-in-window-p)

965 (sit-for (if YaTeX-dos 2 1))

966 (message "Matches with %s at line %d"

967 (YaTeX-replace-format-args YaTeX-struct-begin env "" "")

968 (count-lines (point-min) (point))))))))

969

970 (defun YaTeX-beginning-of-environment (&optional limit-search-bound end)

971 "Goto the beginning of the current environment.

972 Optional argument LIMIT-SEARCH-BOUND non-nil limits the search bound to

973 most recent sectioning command. Non-nil for optional third argument END

974 goes to end of environment."

975 (interactive)

976 (let ((op (point)))

977 (if (YaTeX-inner-environment limit-search-bound)

978 (progn

979 (goto-char (get 'YaTeX-inner-environment 'point))

980 (and end (YaTeX-goto-corresponding-environment))

981 (if (interactive-p) (push-mark op))

982 t))))

983

984 (defun YaTeX-end-of-environment (&optional limit-search-bound)

985 "Goto the end of the current environment.

986 Optional argument LIMIT-SEARCH-BOUND non-nil limits the search bound

987 to most recent sectioning command."

988 (interactive)

989 (YaTeX-beginning-of-environment limit-search-bound t))

990

991 (defun YaTeX-mark-environment ()

992 "Mark current position and move point to end of environment."

993 (interactive)

994 (let ((curp (point)))

995 (if (and (YaTeX-on-begin-end-p) (match-beginning 1)) ;if on \\begin

996 (forward-line 1)

997 (beginning-of-line))

998 (if (not (YaTeX-end-of-environment)) ;arg1 turns to match-beginning 1

999 (progn

1000 (goto-char curp)

1001 (error "Cannot found the end of current environment."))

1002 (YaTeX-goto-corresponding-environment)

1003 (beginning-of-line) ;for confirmation

1004 (if (< curp (point))

1005 (progn

1006 (message "Mark this environment?(y or n): ")

1007 (if (= (read-char) ?y) nil

1008 (goto-char curp)

1009 (error "Abort. Please call again at more proper position."))))

1010 (set-mark-command nil)

1011 (YaTeX-goto-corresponding-environment)

1012 (end-of-line)

1013 (if (eobp) nil (forward-char 1)))))

1014

1015 (defun YaTeX-kill-buffer (buffer)

1016 "Make effort to show parent buffer after kill."

1017 (interactive "bKill buffer: ")

1018 (or (get-buffer buffer)

1019 (error "No such buffer %s" buffer))

1020 (let ((pf YaTeX-parent-file))

1021 (kill-buffer buffer)

1022 (and pf

1023 (get-file-buffer pf)

1024 (switch-to-buffer (get-file-buffer pf)))))

1025

1026 ;;;VER2

1027 (defun YaTeX-insert-struc (what env)

1028 (cond

1029 ((eq what 'begin)

1030 (insert (YaTeX-replace-format-args

1031 YaTeX-struct-begin env (YaTeX-addin env))))

1032 ((eq what 'end)

1033 (insert (YaTeX-replace-format-args YaTeX-struct-end env)))

1034 (t nil)))

1035

1036 ;;; Function for menu support

1037 (defun YaTeX-define-menu (keymap bindlist)

1038 "Define KEYMAP(symbol)'s menu-bindings according to BINDLIST.

1039 KEYMAP should be a quoted symbol of newly allocated keymap.

1040 BINDLIST consists of binding list. Each element is as follows.

1041

1042 '(menusymbol DOC_String . contents)

1043

1044 CONTENTS is one of lambda-form, interactive function, or other keymap.

1045 See yatex19.el for example."

1046 (cond

1047 ((featurep 'xemacs)

1048 (let (name)

1049 (if (keymapp (symbol-value keymap))

1050 (progn

1051 (setq name (keymap-name (symbol-value keymap)))

1052 (set keymap nil))

1053 (setq name (car (symbol-value keymap)))

1054 (set keymap (cdr (symbol-value keymap))))

1055 (mapcar

1056 (function

1057 (lambda (bind)

1058 (setq bind (cdr bind))

1059 (if (eq (car-safe (cdr bind)) 'lambda)

1060 (setcar (cdr bind) 'progn))

1061 (if (stringp (car-safe (cdr bind)))

1062 (set keymap

1063 (cons (cdr bind) (symbol-value keymap)))

1064 (set keymap

1065 (cons (vector (car bind) (cdr bind) t)

1066 (symbol-value keymap))))))

1067 bindlist)

1068 (set keymap (cons name (symbol-value keymap)))))

1069 (t

1070 (mapcar

1071 (function

1072 (lambda (bind)

1073 (define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))

1074 bindlist))))

1075

1076 ;;;

1077 ;; Emacs 21 compensational wrapper

1078 ;;;

1079 (defun YaTeX-minibuffer-begin ()

1080 (if (fboundp 'field-beginning)

1081 (field-beginning (point-max))

1082 (point-min)))

1083

1084 (defun YaTeX-minibuffer-end ()

1085 (if (fboundp 'field-end)

1086 (field-end (point-max))

1087 (point-max)))

1088

1089 (defun YaTeX-minibuffer-string ()

1090 (buffer-substring (YaTeX-minibuffer-begin) (YaTeX-minibuffer-end)))

1091

1092 (defun YaTeX-minibuffer-erase ()

1093 (if (eq (selected-window) (minibuffer-window))

1094 (if (fboundp 'delete-field) (delete-field) (erase-buffer))))

1095

1096 ;;;

1097 ;; hilit19 vs. font-lock

1098 ;;;

1099 (defun YaTeX-convert-pattern-hilit2fontlock (h19pa)

1100 "Convert hilit19's H19PA patterns alist to font-lock's one.

1101 This function is a makeshift for YaTeX and yahtml."

1102 (let ((ignorecase (not (null (car h19pa))))

1103 (palist (cdr h19pa))

1104 flpa i newface

1105 (mapping

1106 '((bold . YaTeX-font-lock-bold-face)

1107 (italic . YaTeX-font-lock-italic-face)

1108 (defun . font-lock-function-name-face)

1109 (define . font-lock-variable-name-face)

1110 (keyword . font-lock-keyword-face)

1111 (decl . YaTeX-font-lock-declaration-face)

1112 (label . YaTeX-font-lock-label-face)

1113 (crossref . YaTeX-font-lock-crossref-face)

1114 (include . YaTeX-font-lock-include-face)

1115 (formula . YaTeX-font-lock-formula-face)

1116 (string . ignore) (comment . ignore)

1117 )))

1118 (while (setq i (car palist))

1119 (setq newface (nth 2 i)

1120 newface (or (cdr (assq newface mapping)) newface))

1121 (cond

1122 ((eq newface 'ignore) nil) ;no translation

1123 ((stringp (car i)) ;hiliting by regexp

1124 (setq flpa

1125 (cons

1126 (if (numberp (car (cdr i)))

1127 (list (car i) ;regexp

1128 (car (cdr i)) ;matching group number

1129 newface nil) ;'keep) ;keep is hilit19 taste

1130 (list

1131 (concat

1132 (car i) ;original regexp and..

1133 ;;"[^"

1134 ;;(regexp-quote (substring (car (cdr i)) 0 1))

1135 ;;"]+" ;for shortest match

1136 ".*"

1137 (car (cdr i)))

1138 0 (list 'quote newface) nil)) ;;'keep))

1139 flpa)))

1140 ((and (symbolp (car i)) (fboundp (car i)))

1141 (setq flpa

1142 (cons

1143 (list (car (cdr i)) ;regexp

1144 (list

1145 (list

1146 'lambda (list 'dummy)

1147 '(goto-char (match-beginning 0))

1148 '(remove-text-properties

1149 (point) (min (point-max) (1+ (point)))

1150 '(face nil font-lock-multiline nil))

1151 (list

1152 'let (list '(e (match-end 0))

1153 (list 'm (list (car i) (car (cdr i)))))

1154 (list

1155 'if 'm

1156 (list

1157 'YaTeX-font-lock-fillin

1158 (list 'car 'm)

1159 (list 'cdr 'm)

1160 (list 'quote 'face)

1161 (list 'quote 'font-lock)

1162 (list 'quote newface))

1163 '(goto-char e)

1164 ))

1165 nil) ;retun nil to cheat font-lock

1166 nil nil)) ;pre-match, post-match both nil

1167 flpa))))

1168 (setq palist (cdr palist)));while

1169 (if (featurep 'xemacsp)

1170 (nreverse flpa)

1171 flpa)))

1172

1173 (if (and (boundp 'YaTeX-use-font-lock)

1174 YaTeX-use-font-lock)

1175 (require 'font-lock))

1176

1177 (cond

1178 ((and (featurep 'font-lock) (fboundp 'defface))

1179 ;; In each defface, '(class static-color) is for Emacs-21 -nw

1180 ;; '(class tty) is for XEmacs-21 -nw

1181 (defface YaTeX-font-lock-label-face

1182 '((((class static-color)) (:foreground "yellow" :underline t))

1183 (((type tty)) (:foreground "yellow" :underline t))

1184 (((class color) (background dark)) (:foreground "pink" :underline t))

1185 (((class color) (background light)) (:foreground "red" :underline t))

1186 (t (:bold t :underline t)))

1187 "Font Lock mode face used to highlight labels."

1188 :group 'font-lock-faces)

1189 (defvar YaTeX-font-lock-label-face 'YaTeX-font-lock-label-face)

1190

1191 (defface YaTeX-font-lock-declaration-face

1192 '((((class color) (background dark)) (:foreground "cyan"))

1193 (((class color) (background light)) (:foreground "RoyalBlue"))

1194 (t (:bold t :underline t)))

1195 "Font Lock mode face used to highlight some declarations."

1196 :group 'font-lock-faces)

1197 (defvar YaTeX-font-lock-declaration-face 'YaTeX-font-lock-declaration-face)

1198

1199 (defface YaTeX-font-lock-include-face

1200 '((((class color) (background dark)) (:foreground "Plum1"))

1201 (((class color) (background light)) (:foreground "purple"))

1202 (t (:bold t :underline t)))

1203 "Font Lock mode face used to highlight expression for including."

1204 :group 'font-lock-faces)

1205 (defvar YaTeX-font-lock-include-face 'YaTeX-font-lock-include-face)

1206

1207 (defface YaTeX-font-lock-formula-face

1208 '((((class static-color)) (:bold t))

1209 (((type tty)) (:bold t))

1210 (((class color) (background dark)) (:foreground "khaki" :bold t))

1211 (((class color) (background light)) (:foreground "Goldenrod"))

1212 (t (:bold t :underline t)))

1213 "Font Lock mode face used to highlight formula."

1214 :group 'font-lock-faces)

1215 (defvar YaTeX-font-lock-formula-face 'YaTeX-font-lock-formula-face)

1216

1217 (defface YaTeX-font-lock-crossref-face

1218 '((((class color) (background dark)) (:foreground "lightgoldenrod"))

1219 (((class color) (background light)) (:foreground "DarkGoldenrod"))

1220 (t (:bold t :underline t)))

1221 "Font Lock mode face used to highlight cress references."

1222 :group 'font-lock-faces)

1223 (defvar YaTeX-font-lock-crossref-face 'YaTeX-font-lock-crossref-face)

1224

1225 (defface YaTeX-font-lock-bold-face

1226 '((t (:bold t)))

1227 "Font Lock mode face used to express bold itself."

1228 :group 'font-lock-faces)

1229 (defvar YaTeX-font-lock-bold-face 'YaTeX-font-lock-bold-face)

1230

1231 (defface YaTeX-font-lock-italic-face

1232 '((t (:italic t)))

1233 "Font Lock mode face used to express italic itself."

1234 :group 'font-lock-faces)

1235 (defvar YaTeX-font-lock-italic-face 'YaTeX-font-lock-italic-face)

1236

1237 ;; Make sure the 'YaTeX-font-lock-{italic,bold}-face is bound with

1238 ;; italic/bold fontsets

1239 (if (and (fboundp 'fontset-list) YaTeX-use-italic-bold)

1240 (let ((flist (fontset-list)) fnt italic bold

1241 (df (or (and (fboundp 'face-font-name) (face-font-name 'default))

1242 (face-font 'default)

1243 (face-font 'italic)

1244 (face-font 'bold)

1245 "giveup!"))

1246 sz medium-i bold-r)

1247 (string-match

1248 "^-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-\$\\([0-9]+\$\\)" df)

1249 (setq sz (or (match-string 1 df) "16"))

1250 (setq medium-i (format "-medium-i-[^-]+--%s" sz)

1251 bold-r (format "-bold-r-[^-]+--%s" sz))

1252 (while flist

1253 (setq fnt (car flist))

1254 (condition-case err

1255 (cond

1256 ((and (string-match medium-i fnt)

1257 (null italic))

1258 (set-face-font 'YaTeX-font-lock-italic-face (setq italic fnt)))

1259 ((and (string-match bold-r fnt) (null bold))

1260 (set-face-font 'YaTeX-font-lock-bold-face (setq bold fnt))))

1261 (error nil))

1262 (setq flist (cdr flist)))))

1263

1264 ;;Borrowed from XEmacs's font-lock.el

1265 (defsubst YaTeX-font-lock-fillin (start end setprop markprop value &optional object)

1266 "Fill in one property of the text from START to END.

1267 Arguments PROP and VALUE specify the property and value to put where none are

1268 already in place. Therefore existing property values are not overwritten.

1269 Optional argument OBJECT is the string or buffer containing the text."

1270 (let ((start (text-property-any start end markprop nil object)) next

1271 (putfunc (if (fboundp 'put-nonduplicable-text-property)

1272 'put-nonduplicable-text-property

1273 'put-text-property)))

1274 (if (eq putfunc 'put-text-property)

1275 (setq markprop setprop))

1276 (while start

1277 (setq next (next-single-property-change start markprop object end))

1278 (funcall putfunc start next setprop value object)

1279 (funcall putfunc start next markprop value object)

1280 (setq start (text-property-any next end markprop nil object)))))

1281

1282 (defun YaTeX-warning-font-lock (mode)

1283 (let ((sw (selected-window)))

1284 ;;(pop-to-buffer (format " *%s warning*" mode))

1285 ;;(erase-buffer)

1286 (momentary-string-display

1287 (cond

1288 (YaTeX-japan

1289 (concat mode " は、既に font-lock に対応しました。\n"

1290 "~/.emacs などにある\n"

1291 "\t(put 'yatex-mode 'font-lock-keywords 'tex-mode)\n"

1292 "\t(put 'yahtml-mode 'font-lock-keywords 'html-mode)\n"

1293 "などの間に合わせの記述はもはや不要です。"))

1294 (t

1295 (concat mode " now supports the font-lock by itself.\n"

1296 "So you can remove the descriptions such as\n"

1297 "\t(put 'yatex-mode 'font-lock-keywords 'tex-mode)\n"

1298 "\t(put 'yahtml-mode 'font-lock-keywords 'html-mode)\n"

1299 "in your ~/.emacs file. Thank you."))) (point))

1300 (select-window sw)))

1301 ))

1302

1303

1304 ;;;

1305 ;; Functions for the Installation time

1306 ;;;

1307

1308 (defun bcf-and-exit ()

1309 "Byte compile rest of argument and kill-emacs."

1310 (if command-line-args-left

1311 (let ((load-path (cons "." load-path)))

1312 (and (fboundp 'set-language-environment)

1313 (featurep 'mule)

1314 (set-language-environment "Japanese"))

1315 (mapcar 'byte-compile-file command-line-args-left)

1316 (kill-emacs))))

1317

1318 (provide 'yatexlib)

1319 ; Local variables:

1320 ; fill-prefix: ";;; "

1321 ; paragraph-start: "^$\\|\\|;;;$"

1322 ; paragraph-separate: "^$\\|\\|;;;$"

1323 ; buffer-file-coding-system: sjis

1324 ; End: