yatex

diff yatexlib.el @ 64:36a48185b95a

Changes are listed in yatex.new. Major one is supporing GNU Emacs20 and XEmacs.
author yuuji
date Tue, 16 Dec 1997 13:28:38 +0000
parents 48ac97a6b6ce
children 0eb6997bee16
line diff
     1.1 --- a/yatexlib.el	Wed May 01 15:35:40 1996 +0000
     1.2 +++ b/yatexlib.el	Tue Dec 16 13:28:38 1997 +0000
     1.3 @@ -1,10 +1,283 @@
     1.4  ;;; -*- Emacs-Lisp -*-
     1.5 -;;; YaTeX library of general functions.
     1.6 +;;; YaTeX and yahtml common libraries, general functions and definitions
     1.7  ;;; yatexlib.el
     1.8 -;;; (c )1994-1995 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp]
     1.9 -;;; Last modified Fri Apr  5 17:56:43 1996 on supra
    1.10 +;;; (c )1994-1997 by HIROSE Yuuji.[yuuji@ae.keio.ac.jp]
    1.11 +;;; Last modified Tue Dec 16 14:48:22 1997 on firestorm
    1.12  ;;; $Id$
    1.13  
    1.14 +;; General variables
    1.15 +(defvar YaTeX-dos (memq system-type '(ms-dos windows-nt OS/2)))
    1.16 +(defvar YaTeX-emacs-19 (>= (string-to-int emacs-version) 19))
    1.17 +(defvar YaTeX-emacs-20 (>= (string-to-int emacs-version) 20))
    1.18 +(defvar YaTeX-user-completion-table
    1.19 +  (if YaTeX-dos "~/_yatexrc" "~/.yatexrc")
    1.20 +  "*Default filename in which user completion table is saved.")
    1.21 +
    1.22 +(defvar YaTeX-japan (or (boundp 'NEMACS) (boundp 'MULE) YaTeX-emacs-20)
    1.23 +  "Whether yatex mode is running on Japanese environment or not.")
    1.24 +
    1.25 +(defvar YaTeX-kanji-code-alist
    1.26 +  (cond
    1.27 +   ((boundp '*junet*)
    1.28 +    (list (cons
    1.29 +	   1
    1.30 +	   (if YaTeX-dos (if (boundp '*sjis-dos*) *sjis-dos* *sjis*dos)
    1.31 +	     *sjis*))
    1.32 +	  '(2 . *junet*) '(3 . *euc-japan*)))
    1.33 +   (YaTeX-emacs-20
    1.34 +    ;;(cdr-safe(assq 'coding-system (assoc "Japanese" language-info-alist)))
    1.35 +    (list (cons
    1.36 +	   1 (cond (YaTeX-dos 'shift_jis-dos)
    1.37 +		   ((member 'shift_jis (coding-system-list)) 'shift_jis-unix)
    1.38 +		   (t 'sjis)))
    1.39 +	  '(2 . iso-2022-7bit-unix)
    1.40 +	  '(3 . euc-japan))))
    1.41 +  "Kanji-code expression translation table.")
    1.42 +(defvar YaTeX-inhibit-prefix-letter nil
    1.43 +  "*T for changing key definitions from [prefix] Letter to [prefix] C-Letter.")
    1.44 +
    1.45 +(defvar YaTeX-no-begend-shortcut nil
    1.46 +  "*T for disabling shortcut of begin-type completion, [prefix] b d, etc.")
    1.47 +
    1.48 +(defvar YaTeX-default-pop-window-height 10
    1.49 +  "Default typesetting buffer height.
    1.50 +If integer, sets the window-height of typesetting buffer.
    1.51 +If string, sets the percentage of it.
    1.52 +If nil, use default pop-to-buffer.")
    1.53 +
    1.54 +(defvar YaTeX-create-file-prefix-g nil
    1.55 +  "*Non-nil creates new file when [prefix] g on \\include{foo}.")
    1.56 +
    1.57 +(defvar YaTeX-nervous t
    1.58 +  "*If you are nervous about maintenance of yatexrc, set this value to T.
    1.59 +And you will have the local dictionary.")
    1.60 +
    1.61 +;----------- work variables ----------------------------------------
    1.62 +(defvar YaTeX-typesetting-mode-map nil
    1.63 +  "Keymap used in YaTeX typesetting buffer"
    1.64 +)
    1.65 +(if YaTeX-typesetting-mode-map nil
    1.66 +  (setq YaTeX-typesetting-mode-map (make-keymap))
    1.67 +  ;(suppress-keymap YaTeX-typesetting-mode-map t)
    1.68 +  (define-key YaTeX-typesetting-mode-map " " 'YaTeX-jump-error-line)
    1.69 +  (define-key YaTeX-typesetting-mode-map "\C-m" 'YaTeX-send-string)
    1.70 +  (define-key YaTeX-typesetting-mode-map "1" 'delete-other-windows)
    1.71 +  (define-key YaTeX-typesetting-mode-map "0" 'delete-window)
    1.72 +  (define-key YaTeX-typesetting-mode-map "q" 'delete-window))
    1.73 +
    1.74 +(defvar YaTeX-parent-file nil
    1.75 +  "*Main LaTeX source file name used when %#! expression doesn't exist.")
    1.76 +(make-variable-buffer-local 'YaTeX-parent-file)
    1.77 +
    1.78 +;---------- Define default key bindings on YaTeX mode map ----------
    1.79 +;;;###autoload
    1.80 +(defun YaTeX-define-key (key binding &optional map)
    1.81 +  "Define key on YaTeX-prefix-map."
    1.82 +  (if YaTeX-inhibit-prefix-letter
    1.83 +      (let ((c (aref key 0)))
    1.84 +	(cond
    1.85 +	 ((and (>= c ?a) (<= c ?z)) (aset key 0 (1+ (- c ?a))))
    1.86 +	 ((and (>= c ?A) (<= c ?Z) (numberp YaTeX-inhibit-prefix-letter))
    1.87 +	  (aset key 0 (1+ (- c ?A))))
    1.88 +	 (t nil))))
    1.89 +  (define-key (or map YaTeX-prefix-map) key binding))
    1.90 +
    1.91 +;;;###autoload
    1.92 +(defun YaTeX-local-table-symbol (symbol)
    1.93 +  "Return the lisp symbol which keeps local completion table of SYMBOL."
    1.94 +  (intern (concat "YaTeX$"
    1.95 +		  default-directory
    1.96 +		  (symbol-name symbol))))
    1.97 +
    1.98 +;;;###autoload
    1.99 +(defun YaTeX-sync-local-table (symbol)
   1.100 +  "Synchronize local variable SYMBOL.
   1.101 +Copy its corresponding directory dependent completion table to SYMBOL."
   1.102 +  (if (boundp (YaTeX-local-table-symbol symbol))
   1.103 +      (set symbol (symbol-value (YaTeX-local-table-symbol symbol)))))
   1.104 +
   1.105 +(defvar YaTeX-user-table-is-read nil
   1.106 +  "Flag that means whether user completion table has been read or not.")
   1.107 +;;;###autoload
   1.108 +(defun YaTeX-read-user-completion-table (&optional forcetoread)
   1.109 +  "Append user completion table of LaTeX macros"
   1.110 +  (let*((user-table (expand-file-name YaTeX-user-completion-table))
   1.111 +	(local-table (expand-file-name (file-name-nondirectory user-table)))
   1.112 +	var localvar localbuf (curbuf (current-buffer)) sexp)
   1.113 +    (if YaTeX-user-table-is-read nil
   1.114 +      (message "Loading user completion table")
   1.115 +      (if (file-exists-p user-table) (load-file user-table)
   1.116 +	(message "Welcome to the field of YaTeX.  I'm glad to see you!")))
   1.117 +    (setq YaTeX-user-table-is-read t)
   1.118 +    (cond
   1.119 +     ((file-exists-p local-table)
   1.120 +      (set-buffer (setq localbuf (find-file-noselect local-table)))
   1.121 +      (widen)
   1.122 +      (goto-char (point-min))
   1.123 +      (while (re-search-forward "(setq \\([^ ]+\\)" nil t)
   1.124 +	(setq var (intern (buffer-substring
   1.125 +			   (match-beginning 1) (match-end 1)))
   1.126 +	      localvar (YaTeX-local-table-symbol var))
   1.127 +	(goto-char (match-beginning 0))
   1.128 +	(setq sexp (buffer-substring (point)
   1.129 +				     (progn (forward-sexp) (point))))
   1.130 +	(set-buffer curbuf)
   1.131 +	(or (assq var (buffer-local-variables)) (make-local-variable var))
   1.132 +	(eval (read sexp))
   1.133 +	(or (and (boundp localvar)
   1.134 +		 (symbol-value localvar)
   1.135 +		 (not forcetoread))
   1.136 +	    (set localvar (symbol-value var)))
   1.137 +	(set-buffer localbuf))
   1.138 +      (kill-buffer localbuf)))
   1.139 +    (set-buffer curbuf)))
   1.140 +
   1.141 +;;;###autoload
   1.142 +(defun YaTeX-reload-dictionary ()
   1.143 +  "Reload local dictionary.
   1.144 +Use this function after editing ./.yatexrc."
   1.145 +  (interactive)
   1.146 +  (let ((YaTeX-user-table-is-read nil))
   1.147 +    (YaTeX-read-user-completion-table t)))
   1.148 +
   1.149 +;;;###autoload
   1.150 +(defun YaTeX-lookup-table (word type)
   1.151 +  "Lookup WORD in completion table whose type is TYPE.
   1.152 +This function refers the symbol tmp-TYPE-table, user-TYPE-table, TYPE-table.
   1.153 +Typically, TYPE is one of 'env, 'section, 'fontsize, 'singlecmd."
   1.154 +  (if (symbolp type) (setq type (symbol-name type)))
   1.155 +  (or (assoc word (symbol-value (intern (concat "tmp-" type "-table"))))
   1.156 +      (assoc word (symbol-value (intern (concat "user-" type "-table"))))
   1.157 +      (assoc word (symbol-value (intern (concat type "-table"))))))
   1.158 +
   1.159 +;;;###autoload
   1.160 +(defun YaTeX-update-table (vallist default-table user-table local-table)
   1.161 +  "Update completion table if the car of VALLIST is not in current tables.
   1.162 +Second argument DEFAULT-TABLE is the quoted symbol of default completion
   1.163 +table, third argument USER-TABLE is user table which will be saved in
   1.164 +YaTeX-user-completion-table, fourth argument LOCAL-TABLE should have the
   1.165 +completion which is valid during current Emacs's session.  If you
   1.166 +want to make LOCAL-TABLE valid longer span (but restrict in this directory)
   1.167 +create the file in current directory which has the same name with
   1.168 +YaTeX-user-completion-table."
   1.169 +  (let ((car-v (car vallist)) key answer
   1.170 +	(file (file-name-nondirectory YaTeX-user-completion-table)))
   1.171 +    (cond
   1.172 +     ((assoc car-v (symbol-value default-table))
   1.173 +      nil) ;Nothing to do
   1.174 +     ((setq key (assoc car-v (symbol-value user-table)))
   1.175 +      (if (equal (cdr vallist) (cdr key)) nil
   1.176 +	;; if association hits, but contents differ.
   1.177 +	(message
   1.178 +	 "%s's attributes turned into %s" (car vallist) (cdr vallist))
   1.179 +	(set user-table (delq key (symbol-value user-table)))
   1.180 +	(set user-table (cons vallist (symbol-value user-table)))
   1.181 +	(YaTeX-update-dictionary
   1.182 +	 YaTeX-user-completion-table user-table "user")))
   1.183 +     ((setq key (assoc car-v (symbol-value local-table)))
   1.184 +      (if (equal (cdr vallist) (cdr key)) nil
   1.185 +	(message
   1.186 +	 "%s's attributes turned into %s" (car vallist) (cdr vallist))
   1.187 +	(set local-table (delq key (symbol-value local-table)))
   1.188 +	(set local-table (cons vallist (symbol-value local-table)))
   1.189 +	(set (YaTeX-local-table-symbol local-table) (symbol-value local-table))
   1.190 +	(YaTeX-update-dictionary file local-table)))
   1.191 +     ;; All of above cases, there are some completion in tables.
   1.192 +     ;; Then update tables.
   1.193 +     (t
   1.194 +      (if (not YaTeX-nervous)
   1.195 +	  (setq answer "u")
   1.196 +	(message
   1.197 +	 (cond
   1.198 +	  (YaTeX-japan
   1.199 +	   "`%s'$B$NEPO?@h(B: U)$B%f!<%6<-=q(B L)$B%m!<%+%k<-=q(B N)$B%a%b%j(B D)$B$7$J$$(B")
   1.200 +	  (t
   1.201 +	   "Register `%s' into: U)serDic L)ocalDic N)one D)iscard"))
   1.202 +	 (if (> (length car-v) 23)
   1.203 +	     (concat (substring car-v 0 10) "..." (substring car-v -10))
   1.204 +	   car-v))
   1.205 +	(setq answer (char-to-string (read-char))))
   1.206 +      (cond
   1.207 +       ((string-match answer "uy")
   1.208 +	(set user-table (cons vallist (symbol-value user-table)))
   1.209 +	(YaTeX-update-dictionary YaTeX-user-completion-table user-table "user")
   1.210 +	)
   1.211 +       ((string-match answer "tl")
   1.212 +	(set local-table (cons vallist (symbol-value local-table)))
   1.213 +	(set (YaTeX-local-table-symbol local-table) (symbol-value local-table))
   1.214 +	(YaTeX-update-dictionary file local-table))
   1.215 +       ((string-match answer "d") nil)	;discard it
   1.216 +       (t (set default-table
   1.217 +	       (cons vallist (symbol-value default-table)))))))))
   1.218 +
   1.219 +;;;###autoload
   1.220 +(defun YaTeX-cplread-with-learning
   1.221 +  (prom default-table user-table local-table
   1.222 +	&optional pred reqmatch init hsym)
   1.223 +  "Completing read with learning.
   1.224 +Do a completing read with prompt PROM.  Completion table is what
   1.225 +DEFAULT-TABLE, USER-TABLE, LOCAL table are appended in reverse order.
   1.226 +Note that these tables are passed by the symbol.
   1.227 +Optional arguments PRED, REQMATH and INIT are passed to completing-read
   1.228 +as its arguments PREDICATE, REQUIRE-MATCH and INITIAL-INPUT respectively.
   1.229 +If optional 8th argument HSYM, history symbol, is passed, use it as
   1.230 +history list variable."
   1.231 +  (YaTeX-sync-local-table local-table)
   1.232 +  (let*((table (append (symbol-value local-table)
   1.233 +		       (symbol-value user-table)
   1.234 +		       (symbol-value default-table)))
   1.235 +	(word (completing-read-with-history
   1.236 +	       prom table pred reqmatch init hsym)))
   1.237 +    (if (and (string< "" word) (not (assoc word table)))
   1.238 +	(YaTeX-update-table (list word) default-table user-table local-table))
   1.239 +    word))
   1.240 +
   1.241 +;;;###autoload
   1.242 +(defun YaTeX-update-dictionary (file symbol &optional type)
   1.243 +  (let ((local-table-buf (find-file-noselect file))
   1.244 +	(name (symbol-name symbol))
   1.245 +	(value (symbol-value symbol)))
   1.246 +    (save-excursion
   1.247 +      (message "Updating %s dictionary..." (or type "local"))
   1.248 +      (set-buffer local-table-buf)
   1.249 +      (goto-char (point-max))
   1.250 +      (search-backward (concat "(setq " name) nil t)
   1.251 +      (delete-region (point) (progn (forward-sexp) (point)))
   1.252 +      (delete-blank-lines)
   1.253 +      (insert "(setq " name " '(\n")
   1.254 +      (mapcar '(lambda (s)
   1.255 +		 (insert (format "%s\n" (prin1-to-string s))))
   1.256 +	      value)
   1.257 +      (insert "))\n\n")
   1.258 +      (delete-blank-lines)
   1.259 +      (basic-save-buffer)
   1.260 +      (kill-buffer local-table-buf)
   1.261 +      (message "Updating %s dictionary...Done" (or type "local")))))
   1.262 +
   1.263 +;;;###autoload
   1.264 +(defun YaTeX-define-begend-key-normal (key env &optional map)
   1.265 +  "Define short cut YaTeX-make-begin-end key."
   1.266 +  (YaTeX-define-key
   1.267 +   key
   1.268 +   (list 'lambda '(arg) '(interactive "P")
   1.269 +	 (list 'YaTeX-insert-begin-end env 'arg))
   1.270 +   map))
   1.271 +
   1.272 +;;;###autoload
   1.273 +(defun YaTeX-define-begend-region-key (key env &optional map)
   1.274 +  "Define short cut YaTeX-make-begin-end-region key."
   1.275 +  (YaTeX-define-key key (list 'lambda nil '(interactive)
   1.276 +			      (list 'YaTeX-insert-begin-end env t)) map))
   1.277 +
   1.278 +;;;###autoload
   1.279 +(defun YaTeX-define-begend-key (key env &optional map)
   1.280 +  "Define short cut key for begin type completion both for normal
   1.281 +and region mode.  To customize YaTeX, user should use this function."
   1.282 +  (YaTeX-define-begend-key-normal key env map)
   1.283 +  (if YaTeX-inhibit-prefix-letter nil
   1.284 +    (YaTeX-define-begend-region-key
   1.285 +     (concat (upcase (substring key 0 1)) (substring key 1)) env)))
   1.286 +
   1.287  ;;;###autoload
   1.288  (defun YaTeX-search-active-forward (string cmntrx &optional bound err cnt func)
   1.289    "Search STRING which is not commented out by CMNTRX.
   1.290 @@ -16,7 +289,8 @@
   1.291  		    (setq found (funcall sfunc string bound err cnt))
   1.292  		  (setq md (match-data)))
   1.293  		(or
   1.294 -		 (YaTeX-in-verb-p (match-beginning 0))
   1.295 +		 (and (eq major-mode 'yatex-mode)
   1.296 +		      (YaTeX-in-verb-p (match-beginning 0)))
   1.297  		 (save-excursion
   1.298  		   (beginning-of-line)
   1.299  		   (re-search-forward cmntrx (match-beginning 0) t)))))
   1.300 @@ -119,8 +393,16 @@
   1.301  	(setq index pos) (setq pos -1))
   1.302         (t (setq pos (1- pos))))
   1.303        )
   1.304 -    index)
   1.305 -)
   1.306 +    index))
   1.307 +
   1.308 +;;;###autoload
   1.309 +(defun point-beginning-of-line ()
   1.310 +  (save-excursion (beginning-of-line)(point)))
   1.311 +
   1.312 +;;;###autoload
   1.313 +(defun point-end-of-line ()
   1.314 +  (save-excursion (end-of-line)(point)))
   1.315 +
   1.316  
   1.317  ;;;###autoload
   1.318  (defun YaTeX-showup-buffer (buffer &optional func select)
   1.319 @@ -371,11 +653,158 @@
   1.320    (or (featurep 'windows) (error "Why don't you use `windows.el'?"))
   1.321    (win-switch-to-window 1 (- last-command-char win:base-key)))
   1.322  
   1.323 +;;;###autoload
   1.324 +(defun YaTeX-reindent (col)
   1.325 +  "Remove current indentation and reindento to COL column."
   1.326 +  (save-excursion
   1.327 +    (beginning-of-line)
   1.328 +    (skip-chars-forward " \t")
   1.329 +    (if (/= col (current-column))
   1.330 +	(progn
   1.331 +	  (delete-region (point) (progn (beginning-of-line) (point)))
   1.332 +	  (indent-to col))))
   1.333 +  (skip-chars-forward " \t" (point-end-of-line)))
   1.334 +
   1.335 +(defun YaTeX-inner-environment (&optional quick)
   1.336 +  "Return current inner-most environment.
   1.337 +Non-nil for optional argument QUICK restricts search bound to most
   1.338 +recent sectioning command.  Matching point is stored to property 'point
   1.339 +of 'YaTeX-inner-environment, which can be referred by
   1.340 + (get 'YaTeX-inner-environment 'point)."
   1.341 +  (let*((nest 0)
   1.342 +	(beg (YaTeX-replace-format-args
   1.343 +	      (regexp-quote YaTeX-struct-begin)
   1.344 +	      ;YaTeX-struct-begin		;=== TENTATIVE!! ==
   1.345 +	      YaTeX-struct-name-regexp
   1.346 +	      (if (eq major-mode 'yahtml-mode) "\\s *.*" "")
   1.347 +	      ""))
   1.348 +	(end (YaTeX-replace-format-args
   1.349 +	      (regexp-quote YaTeX-struct-end)
   1.350 +	      YaTeX-struct-name-regexp "" ""))
   1.351 +	(begend (concat "\\(" beg "\\)\\|\\(" end "\\)"))
   1.352 +	bound m0
   1.353 +	(htmlp (eq major-mode 'yahtml-mode))
   1.354 +	(open
   1.355 +	 (concat "^" (or (cdr (assq major-mode '((yahtml-mode . "<")))) "{")))
   1.356 +	(close
   1.357 +	 (concat "^"
   1.358 +		 (or (cdr(assq major-mode '((yahtml-mode . "\n\t >")))) "}"))))
   1.359 +    (save-excursion
   1.360 +      (if quick
   1.361 +	  (setq bound
   1.362 +		(save-excursion
   1.363 +		  (if htmlp 
   1.364 +		      ;;(re-search-backward YaTeX-sectioning-regexp nil 1)
   1.365 +		      (goto-char (point-min)) ;Is this enough? 97/6/26
   1.366 +		    (YaTeX-re-search-active-backward
   1.367 +		     (concat YaTeX-ec-regexp
   1.368 +			     "\\(" YaTeX-sectioning-regexp "\\)\\*?{")
   1.369 +		     YaTeX-comment-prefix nil 1))
   1.370 +		  (or (bobp) (end-of-line))
   1.371 +		  (point))))
   1.372 +      (if (catch 'begin
   1.373 +	    (if (and (numberp bound) (< (point) bound)) (throw 'begin nil))
   1.374 +	    (while (YaTeX-re-search-active-backward
   1.375 +		    begend YaTeX-comment-prefix bound t)
   1.376 +	      (setq m0 (match-beginning 0))
   1.377 +	      (if (looking-at end) ;;(match-beginning 2)
   1.378 +		  (setq nest (1+ nest))
   1.379 +		(setq nest (1- nest)))
   1.380 +	      (if (< nest 0)
   1.381 +		  (progn
   1.382 +		    (put 'YaTeX-inner-environment 'point m0)
   1.383 +		    (goto-char m0)
   1.384 +		    (put 'YaTeX-inner-environment 'indent (current-column))
   1.385 +		    (throw 'begin t)))))
   1.386 +	  (buffer-substring
   1.387 +	   (progn (skip-chars-forward open) (1+ (point)))
   1.388 +	   (progn (skip-chars-forward close) (point))))))
   1.389 +)
   1.390 +
   1.391 +(defun YaTeX-end-environment ()
   1.392 +  "Close opening environment"
   1.393 +  (interactive)
   1.394 +  (let ((env (YaTeX-inner-environment)))
   1.395 +    (if (not env) (error "No premature environment")
   1.396 +      (save-excursion
   1.397 +	(if (YaTeX-search-active-forward
   1.398 +	     (YaTeX-replace-format-args YaTeX-struct-end env "" "")
   1.399 +	     YaTeX-comment-prefix nil t)
   1.400 +	    (if (y-or-n-p
   1.401 +		 (concat "Environment `" env
   1.402 +			 "' may be already closed. Force close?"))
   1.403 +		nil
   1.404 +	      (error "end environment aborted."))))
   1.405 +      (message "")			;Erase (y or n) message.
   1.406 +      (YaTeX-insert-struc 'end env)
   1.407 +      (save-excursion
   1.408 +	(goto-char (or (get 'YaTeX-inner-environment 'point) (match-end 0)))
   1.409 +	(if (pos-visible-in-window-p)
   1.410 +	    (sit-for (if YaTeX-dos 2 1))
   1.411 +	  (message "Matches with %s at line %d"
   1.412 +		   (YaTeX-replace-format-args YaTeX-struct-begin env "" "")
   1.413 +		   (count-lines (point-min) (point)))))))
   1.414 +)
   1.415 +
   1.416 +;;;VER2
   1.417 +(defun YaTeX-insert-struc (what env)
   1.418 +  (cond
   1.419 +   ((eq what 'begin)
   1.420 +    (insert (YaTeX-replace-format-args
   1.421 +	     YaTeX-struct-begin env (YaTeX-addin env))))
   1.422 +   ((eq what 'end)
   1.423 +    (insert (YaTeX-replace-format-args YaTeX-struct-end env)))
   1.424 +   (t nil))
   1.425 +)
   1.426 +
   1.427 +;;; Function for menu support
   1.428 +(defun YaTeX-define-menu (keymap bindlist)
   1.429 +  "Define KEYMAP(symbol)'s menu-bindings according to BINDLIST.
   1.430 +KEYMAP should be a quoted symbol of newly allocated keymap.
   1.431 +BINDLIST consists of binding list.  Each element is as follows.
   1.432 +
   1.433 + '(menusymbol DOC_String . contents)
   1.434 +
   1.435 +CONTENTS is one of lambda-form, interactive function, or other keymap.
   1.436 +See yatex19.el for example."
   1.437 +  (cond
   1.438 +   ((featurep 'xemacs)
   1.439 +    (let (name)
   1.440 +      (if (keymapp (symbol-value keymap))
   1.441 +	  (progn
   1.442 +	    (setq name (keymap-name (symbol-value keymap)))
   1.443 +	    (set keymap nil))
   1.444 +	(setq name (car (symbol-value keymap)))
   1.445 +	(set keymap (cdr (symbol-value keymap))))
   1.446 +      (mapcar
   1.447 +       (function
   1.448 +	(lambda (bind)
   1.449 +	  (setq bind (cdr bind))
   1.450 +	   (if (eq (car-safe (cdr bind)) 'lambda)
   1.451 +	       (setcar (cdr bind) 'progn))
   1.452 +	   (if (stringp (car-safe (cdr bind)))
   1.453 +	       (set keymap
   1.454 +		    (cons (cdr bind) (symbol-value keymap)))
   1.455 +	     (set keymap
   1.456 +		  (cons (vector (car bind) (cdr bind) t)
   1.457 +			(symbol-value keymap))))))
   1.458 +       bindlist)
   1.459 +      (set keymap (cons name (symbol-value keymap)))))
   1.460 +   (t
   1.461 +    (mapcar
   1.462 +     (function
   1.463 +      (lambda (bind)
   1.464 +	(define-key (symbol-value keymap) (vector (car bind)) (cdr bind))))
   1.465 +     bindlist))))
   1.466 +
   1.467 +
   1.468 +
   1.469  (defun bcf-and-exit ()
   1.470    "Byte compile rest of argument and kill-emacs."
   1.471    (if command-line-args-left
   1.472        (progn
   1.473  	(mapcar 'byte-compile-file command-line-args-left)
   1.474  	(kill-emacs))))
   1.475 +
   1.476  	
   1.477  (provide 'yatexlib)