Mercurial > hg > xemacs-beta

comparison lisp/derived.el @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents c5d627a313b1
children
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
144 (if (and docstring (not (stringp docstring))) 144 (if (and docstring (not (stringp docstring)))
145 (progn (setq body (cons docstring body)) 145 (progn (setq body (cons docstring body))
146 (setq docstring nil))) 146 (setq docstring nil)))
147 (setq docstring (or docstring (derived-mode-make-docstring parent child))) 147 (setq docstring (or docstring (derived-mode-make-docstring parent child)))
148 148
149 (` (progn 149 `(progn
150 (derived-mode-init-mode-variables (quote (, child))) 150 (derived-mode-init-mode-variables (quote ,child))
151 (defun (, child) () 151 (defun ,child ()
152 (, docstring) 152 ,docstring
153 (interactive) 153 (interactive)
154 ; Run the parent. 154 ; Run the parent.
155 ((, parent)) 155 (,parent)
156 ; Identify special modes. 156 ; Identify special modes.
157 (if (get (quote (, parent)) 'special) 157 (if (get (quote ,parent) 'special)
158 (put (quote (, child)) 'special t)) 158 (put (quote ,child) 'special t))
159 ;; XEmacs addition 159 ;; XEmacs addition
160 (let ((mode-class (get (quote (, parent)) 'mode-class))) 160 (let ((mode-class (get (quote ,parent) 'mode-class)))
161 (if mode-class 161 (if mode-class
162 (put (quote (, child)) 'mode-class mode-class))) 162 (put (quote ,child) 'mode-class mode-class)))
163 ; Identify the child mode. 163 ; Identify the child mode.
164 (setq major-mode (quote (, child))) 164 (setq major-mode (quote ,child))
165 (setq mode-name (, name)) 165 (setq mode-name ,name)
166 ; Set up maps and tables. 166 ; Set up maps and tables.
167 (derived-mode-set-keymap (quote (, child))) 167 (derived-mode-set-keymap (quote ,child))
168 (derived-mode-set-syntax-table (quote (, child))) 168 (derived-mode-set-syntax-table (quote ,child))
169 (derived-mode-set-abbrev-table (quote (, child))) 169 (derived-mode-set-abbrev-table (quote ,child))
170 ; Splice in the body (if any). 170 ; Splice in the body (if any).
171 (,@ body) 171 ,@body
172 ;;; ; Run the setup function, if 172 ;;; ; Run the setup function, if
173 ;;; ; any -- this will soon be 173 ;;; ; any -- this will soon be
174 ;;; ; obsolete. 174 ;;; ; obsolete.
175 ;;; (derived-mode-run-setup-function (quote (, child))) 175 ;;; (derived-mode-run-setup-function (quote ,child))
176 ; Run the hooks, if any. 176 ; Run the hooks, if any.
177 (derived-mode-run-hooks (quote (, child))))))) 177 (derived-mode-run-hooks (quote ,child)))))
178 178
179 179
180 ;; PUBLIC: find the ultimate class of a derived mode. 180 ;; PUBLIC: find the ultimate class of a derived mode.
181 181
182 (defun derived-mode-class (mode) 182 (defun derived-mode-class (mode)
221 empty syntax table, and an empty abbrev table -- these will be merged 221 empty syntax table, and an empty abbrev table -- these will be merged
222 the first time the mode is used." 222 the first time the mode is used."
223 223
224 (if (boundp (derived-mode-map-name mode)) 224 (if (boundp (derived-mode-map-name mode))
225 t 225 t
226 (eval (` (defvar (, (derived-mode-map-name mode)) 226 (eval `(defvar ,(derived-mode-map-name mode)
227 ;; XEmacs change 227 ;; XEmacs change
228 (make-sparse-keymap (derived-mode-map-name mode)) 228 (make-sparse-keymap (derived-mode-map-name mode))
229 (, (format "Keymap for %s." mode))))) 229 ,(format "Keymap for %s." mode)))
230 (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) 230 (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
231 231
232 (if (boundp (derived-mode-syntax-table-name mode)) 232 (if (boundp (derived-mode-syntax-table-name mode))
233 t 233 t
234 (eval (` (defvar (, (derived-mode-syntax-table-name mode)) 234 (eval `(defvar ,(derived-mode-syntax-table-name mode)
235 ;; XEmacs change 235 ;; XEmacs change
236 ;; Make a syntax table which doesn't specify anything 236 ;; Make a syntax table which doesn't specify anything
237 ;; for any char. Valid data will be merged in by 237 ;; for any char. Valid data will be merged in by
238 ;; derived-mode-merge-syntax-tables. 238 ;; derived-mode-merge-syntax-tables.
239 ;; (make-char-table 'syntax-table nil) 239 ;; (make-char-table 'syntax-table nil)
240 (make-syntax-table) 240 (make-syntax-table)
241 (, (format "Syntax table for %s." mode))))) 241 ,(format "Syntax table for %s." mode)))
242 (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) 242 (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
243 243
244 (if (boundp (derived-mode-abbrev-table-name mode)) 244 (if (boundp (derived-mode-abbrev-table-name mode))
245 t 245 t
246 (eval (` (defvar (, (derived-mode-abbrev-table-name mode)) 246 (eval `(defvar ,(derived-mode-abbrev-table-name mode)
247 (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil) 247 (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
248 (make-abbrev-table)) 248 (make-abbrev-table))
249 (, (format "Abbrev table for %s." mode))))))) 249 ,(format "Abbrev table for %s." mode)))))
250 250
251 (defun derived-mode-make-docstring (parent child) 251 (defun derived-mode-make-docstring (parent child)
252 "Construct a docstring for a new mode if none is provided." 252 "Construct a docstring for a new mode if none is provided."
253 253
254 (format "This major mode is a variant of `%s', created by `define-derived-mode'. 254 (format "This major mode is a variant of `%s', created by `define-derived-mode'.