annotate lisp/derived.el @ 5753:dbd8305e13cb

Warn about non-string non-integer ARG to #'gensym, bytecomp.el. lisp/ChangeLog addition: 2013-08-21 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (gensym): * bytecomp.el (byte-compile-gensym): New. Warn that gensym called in a for-effect context is unlikely to be useful. Warn about non-string non-integer ARGs, this is incorrect. Am not changing the function to error with same, most code that makes the mistake is has no problems, which is why it has survived so long. * window-xemacs.el (save-window-excursion/mapping): * window.el (save-window-excursion): Call #'gensym with a string, not a symbol.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 21 Aug 2013 19:02:59 +0100
parents 308d34e9f07d
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
1 ;;; derived.el --- allow inheritance of major modes
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
2 ;;; (formerly mode-clone.el)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
4 ;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
12 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
13 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
14 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
15 ;; option) any later version.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
20 ;; for more details.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3163
diff changeset
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
25 ;;; Synched up with: FSF 21.3.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 428
diff changeset
31 ;; XEmacs is already, in a sense, object oriented -- each object
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; (buffer) belongs to a class (major mode), and that class defines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; the relationship between messages (input events) and methods
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; (commands) by means of a keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; The only thing missing is a good scheme of inheritance. It is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; possible to simulate a single level of inheritance with generous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; use of hooks and a bit of work -- sgml-mode, for example, also runs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; the hooks for text-mode, and keymaps can inherit from other keymaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; -- but generally, each major mode ends up reinventing the wheel.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; Ideally, someone should redesign all of Emacs's major modes to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; follow a more conventional object-oriented system: when defining a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; new major mode, the user should need only to name the existing mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; it is most similar to, then list the (few) differences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; In the mean time, this package offers most of the advantages of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; full inheritance with the existing major modes. The macro
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; `define-derived-mode' allows the user to make a variant of an existing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; major mode, with its own keymap. The new mode will inherit the key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; bindings of its parent, and will, in fact, run its parent first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; every time it is called. For example, the commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; (define-derived-mode hypertext-mode text-mode "Hypertext"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; (setq case-fold-search nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; will create a function `hypertext-mode' with its own (sparse)
3061
fd1acd2f457a [xemacs-hg @ 2005-11-13 07:39:26 by ben]
ben
parents: 2142
diff changeset
60 ;; keymap `hypertext-mode-map'. The command M-x hypertext-mode will
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; perform the following actions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; - run the command (text-mode) to get its default setup
3061
fd1acd2f457a [xemacs-hg @ 2005-11-13 07:39:26 by ben]
ben
parents: 2142
diff changeset
64 ;; - replace the current keymap with 'hypertext-mode-map', which will
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; inherit from 'text-mode-map'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; - replace the current syntax table with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; 'hypertext-mode-syntax-table', which will borrow its defaults
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; from the current text-mode-syntax-table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; - replace the current abbrev table with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; 'hypertext-mode-abbrev-table', which will borrow its defaults
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; from the current text-mode-abbrev table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;; - change the mode line to read "Hypertext"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; - assign the value 'hypertext-mode' to the 'major-mode' variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; - run the body of commands provided in the macro -- in this case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; set the local variable `case-fold-search' to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; The advantages of this system are threefold. First, text mode is
3061
fd1acd2f457a [xemacs-hg @ 2005-11-13 07:39:26 by ben]
ben
parents: 2142
diff changeset
78 ;; untouched -- if you had added the new keystroke to `text-mode-map',
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; possibly using hooks, you would have added it to all text buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; -- here, it appears only in hypertext buffers, where it makes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; sense. Second, it is possible to build even further, and make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; a derived mode from a derived mode. The commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; (define-derived-mode html-mode hypertext-mode "HTML")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;; [various key definitions]
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
86 ;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;; will add a new major mode for HTML with very little fuss.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;;
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
89 ;; Note also the function `derived-mode-p' which can tell if the current
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
90 ;; mode derives from another. In a hypertext-mode, buffer, for example,
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
91 ;; (derived-mode-p 'text-mode) would return non-nil. This should always
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
92 ;; be used in place of (eq major-mode 'text-mode).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
96 ;;; PRIVATE: defsubst must be defined before they are first used
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
97
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
98 (defsubst derived-mode-hook-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
99 "Construct the mode hook name based on mode name MODE."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
100 (intern (concat (symbol-name mode) "-hook")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
101
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
102 (defsubst derived-mode-map-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
103 "Construct a map name based on a MODE name."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
104 (intern (concat (symbol-name mode) "-map")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
105
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
106 (defsubst derived-mode-syntax-table-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
107 "Construct a syntax-table name based on a MODE name."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
108 (intern (concat (symbol-name mode) "-syntax-table")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
109
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
110 (defsubst derived-mode-abbrev-table-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
111 "Construct an abbrev-table name based on a MODE name."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
112 (intern (concat (symbol-name mode) "-abbrev-table")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
113
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 ;; PUBLIC: define a new major mode which inherits from an existing one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 ;; XEmacs -- no autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (defmacro define-derived-mode (child parent name &optional docstring &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 "Create a new mode as a variant of an existing mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 The arguments to this command are as follow:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 CHILD: the name of the command for the derived mode.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
123 PARENT: the name of the command for the parent mode (e.g. `text-mode')
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
124 or nil if there is no parent.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
125 NAME: a string which will appear in the status line (e.g. \"Hypertext\")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 DOCSTRING: an optional documentation string--if you do not supply one,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 the function will attempt to invent something useful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 BODY: forms to execute just before running the
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
129 hooks for the new mode. Do not use `interactive' here.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
130
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
131 BODY can start with a bunch of keyword arguments. The following keyword
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
132 arguments are currently understood:
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
133 :group GROUP
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
134 Declare the customization group that corresponds to this mode.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
135 :syntax-table TABLE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
136 Use TABLE instead of the default.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
137 A nil value means to simply use the same syntax-table as the parent.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
138 :abbrev-table TABLE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
139 Use TABLE instead of the default.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
140 A nil value means to simply use the same abbrev-table as the parent.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 You could then make new key bindings for `LaTeX-thesis-mode-map'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 without changing regular LaTeX mode. In this example, BODY is empty,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 and DOCSTRING is generated by default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
150 On a more complicated level, the following command uses `sgml-mode' as
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 the parent, and then sets the variable `case-fold-search' to nil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (define-derived-mode article-mode sgml-mode \"Article\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 \"Major mode for editing technical articles.\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (setq case-fold-search nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Note that if the documentation string had been left out, it would have
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
158 been generated automatically, with a reference to the keymap.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
159
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
160 The new mode runs the hook constructed by the function
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
161 `derived-mode-hook-name'."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
162 (declare (debug (&define name symbolp sexp [&optional stringp]
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
163 [&rest keywordp sexp] def-body)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
164
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
165 (when (and docstring (not (stringp docstring)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
166 ;; Some trickiness, since what appears to be the docstring may really be
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
167 ;; the first element of the body.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
168 (push docstring body)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
169 (setq docstring nil))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
170
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
171 (when (eq parent 'fundamental-mode) (setq parent nil))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
172
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
173 (let ((map (derived-mode-map-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
174 (syntax (derived-mode-syntax-table-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
175 (abbrev (derived-mode-abbrev-table-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
176 (declare-abbrev t)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
177 (declare-syntax t)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
178 (hook (derived-mode-hook-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
179 (group nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
181 ;; Process the keyword args.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
182 (while (keywordp (car body))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
183 (case (pop body)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
184 (:group (setq group (pop body)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
185 (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
186 (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
187 (t (pop body))))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
188
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
189 (setq docstring (derived-mode-make-docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
190 parent child docstring syntax abbrev))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
192 `(progn
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
193 (defvar ,hook nil ,(format "Hook run when entering %s mode." name))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
194 (defvar ,map (make-sparse-keymap))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
195 ,(if declare-syntax
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
196 `(defvar ,syntax (make-syntax-table)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
197 ,(if declare-abbrev
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
198 `(defvar ,abbrev
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
199 (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
200 (put ',child 'derived-mode-parent ',parent)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
201 ,(if group `(put ',child 'custom-mode-group ,group))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
202
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (defun ,child ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 ,docstring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ; Run the parent.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
207 (delay-mode-hooks
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
208
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
209 (,(or parent 'kill-all-local-variables))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
210 ; Identify the child mode.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
211 (setq major-mode (quote ,child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
212 (setq mode-name ,name)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 ; Identify special modes.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
214 ,(when parent
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
215 `(progn
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
216 (if (get (quote ,parent) 'mode-class)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
217 (put (quote ,child) 'mode-class
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
218 (get (quote ,parent) 'mode-class)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 ; Set up maps and tables.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
220 (unless (keymap-parent ,map)
2140
9da6e6c569f7 [xemacs-hg @ 2004-06-18 04:06:49 by james]
james
parents: 2135
diff changeset
221 (set-keymap-parents ,map (list (current-local-map))))
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
222 ,(when declare-syntax
2140
9da6e6c569f7 [xemacs-hg @ 2004-06-18 04:06:49 by james]
james
parents: 2135
diff changeset
223 ;; XEmacs change: we do not have char-table-parent
9da6e6c569f7 [xemacs-hg @ 2004-06-18 04:06:49 by james]
james
parents: 2135
diff changeset
224 `(derived-mode-merge-syntax-tables
2142
eb65d362090f [xemacs-hg @ 2004-06-18 15:48:38 by james]
james
parents: 2140
diff changeset
225 (syntax-table) ,syntax))))
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
226
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
227 (use-local-map ,map)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
228 ,(when syntax `(set-syntax-table ,syntax))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
229 ,(when abbrev `(setq local-abbrev-table ,abbrev))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 ; Splice in the body (if any).
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
231 ,@body
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
232 )
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
233 ;; Run the hooks, if any.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
234 ;; Make the generated code work in older Emacs versions
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
235 ;; that do not yet have run-mode-hooks.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
236 (if (fboundp 'run-mode-hooks)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
237 (run-mode-hooks ',hook)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
238 (run-hooks ',hook))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 ;; PUBLIC: find the ultimate class of a derived mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (defun derived-mode-class (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
243 "Find the class of a major MODE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 A mode's class is the first ancestor which is NOT a derived mode.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
245 Use the `derived-mode-parent' property of the symbol to trace backwards.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
246 Since major-modes might all derive from `fundamental-mode', this function
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
247 is not very useful."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (while (get mode 'derived-mode-parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (setq mode (get mode 'derived-mode-parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
251 (make-obsolete 'derived-mode-class 'derived-mode-p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
906
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
253 ;; PUBLIC: find if the current mode derives from another.
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
254 ;; from GNU Emacs 21 subr.el
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
255
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
256 (defun derived-mode-p (&rest modes)
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
257 "Non-nil if the current major mode is derived from one of MODES.
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
258 Uses the `derived-mode-parent' property of the symbol to trace backwards."
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
259 (let ((parent major-mode))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
260 (while (and (not (memq parent modes))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
261 (setq parent (get parent 'derived-mode-parent))))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
262 parent))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
263
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
265 ;;; PRIVATE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
266
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
267 (defun derived-mode-make-docstring (parent child &optional
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
268 docstring syntax abbrev)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
269 "Construct a docstring for a new mode if none is provided."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
270
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
271 (let ((map (derived-mode-map-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
272 (hook (derived-mode-hook-name child)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
273
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
274 (unless (stringp docstring)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
275 ;; Use a default docstring.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
276 (setq docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
277 (if (null parent)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
278 (format "Major-mode.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
279 Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
280 (format "Major mode derived from `%s' by `define-derived-mode'.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
281 It inherits all of the parent's attributes, but has its own keymap,
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
282 abbrev table and syntax table:
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
283
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
284 `%s', `%s' and `%s'
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
285
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
286 which more-or-less shadow %s's corresponding tables."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
287 parent map abbrev syntax parent))))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
288
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
289 (unless (string-match (regexp-quote (symbol-name hook)) docstring)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
290 ;; Make sure the docstring mentions the mode's hook.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
291 (setq docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
292 (concat docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
293 (if (null parent)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
294 "\n\nThis mode "
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
295 (concat
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
296 "\n\nIn addition to any hooks its parent mode "
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
297 (if (string-match (regexp-quote (format "`%s'" parent))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
298 docstring) nil
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
299 (format "`%s' " parent))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
300 "might have run,\nthis mode "))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
301 (format "runs the hook `%s'" hook)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
302 ", as the final step\nduring initialization.")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
303
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
304 (unless (string-match "\\\\[{[]" docstring)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
305 ;; And don't forget to put the mode's keymap.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
306 (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
307
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
308 docstring))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
309
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
310
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
311 ;;; OBSOLETE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
312 ;; The functions below are only provided for backward compatibility with
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
313 ;; code byte-compiled with versions of derived.el prior to Emacs-21.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (defsubst derived-mode-setup-function-name (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
316 "Construct a setup-function name based on a MODE name."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (intern (concat (symbol-name mode) "-setup")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ;; Utility functions for defining a derived mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 ;; XEmacs -- don't autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (defun derived-mode-init-mode-variables (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
324 "Initialise variables for a new MODE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 Right now, if they don't already exist, set up a blank keymap, an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 empty syntax table, and an empty abbrev table -- these will be merged
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 the first time the mode is used."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (if (boundp (derived-mode-map-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (eval `(defvar ,(derived-mode-map-name mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (make-sparse-keymap (derived-mode-map-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ,(format "Keymap for %s." mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (if (boundp (derived-mode-syntax-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (eval `(defvar ,(derived-mode-syntax-table-name mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 ;; Make a syntax table which doesn't specify anything
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 ;; for any char. Valid data will be merged in by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 ;; derived-mode-merge-syntax-tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 ;; (make-char-table 'syntax-table nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (make-syntax-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ,(format "Syntax table for %s." mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (if (boundp (derived-mode-abbrev-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (eval `(defvar ,(derived-mode-abbrev-table-name mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
352 (progn
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
353 (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
354 (make-abbrev-table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 ,(format "Abbrev table for %s." mode)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 ;; Utility functions for running a derived mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (defun derived-mode-set-keymap (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
360 "Set the keymap of the new MODE, maybe merging with the parent."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (let* ((map-name (derived-mode-map-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (new-map (eval map-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (old-map (current-local-map)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (and old-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (get map-name 'derived-mode-unmerged)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (derived-mode-merge-keymaps old-map new-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (put map-name 'derived-mode-unmerged nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (use-local-map new-map)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
370 (defun derived-mode-set-syntax-table (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
371 "Set the syntax table of the new MODE, maybe merging with the parent."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (let* ((table-name (derived-mode-syntax-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (old-table (syntax-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (new-table (eval table-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (if (get table-name 'derived-mode-unmerged)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (derived-mode-merge-syntax-tables old-table new-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (put table-name 'derived-mode-unmerged nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (set-syntax-table new-table)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (defun derived-mode-set-abbrev-table (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
381 "Set the abbrev table for MODE if it exists.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 Always merge its parent into it, since the merge is non-destructive."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (let* ((table-name (derived-mode-abbrev-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (old-table local-abbrev-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (new-table (eval table-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (derived-mode-merge-abbrev-tables old-table new-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (setq local-abbrev-table new-table)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 ;;;(defun derived-mode-run-setup-function (mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 ;;; "Run the setup function if it exists."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 ;;; (let ((fname (derived-mode-setup-function-name mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 ;;; (if (fboundp fname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 ;;; (funcall fname))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (defun derived-mode-run-hooks (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
397 "Run the mode hook for MODE."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
398 (let ((hooks-name (derived-mode-hook-name mode)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (if (boundp hooks-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (run-hooks hooks-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; Functions to merge maps and tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (defun derived-mode-merge-keymaps (old new)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
405 "Merge an OLD keymap into a NEW one.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
406 The old keymap is set to be the last cdr of the new one, so that there will
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 be automatic inheritance."
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
408 ;; XEmacs change. FSF 19.30 to 21.3 has a whole bunch of weird crap here
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 ;; for merging prefix keys and such. Hopefully none of this is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ;; necessary in XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (set-keymap-parents new (list old)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (defun derived-mode-merge-syntax-tables (old new)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
414 "Merge an OLD syntax table into a NEW one.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 Where the new table already has an entry, nothing is copied from the old one."
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
416 ;; XEmacs change: on the other hand, Emacs 21.3 just has
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
417 ;; (set-char-table-parent new old) here.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
418 ;; We use map-char-table, not map-syntax-table, so we can explicitly
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
419 ;; check for inheritance.
3163
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
420 (map-char-table
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
421 #'(lambda (key value)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
422 (let ((newval (get-range-char-table key new 'multi)))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
423 (cond ((eq newval 'multi) ; OK, dive into the class hierarchy
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
424 (map-char-table
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
425 #'(lambda (key1 value1)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
426 (when (eq ?@ (char-syntax-from-code
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
427 (get-range-char-table key new ?@)))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
428 (put-char-table key1 value new))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
429 nil)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
430 new
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
431 key))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
432 ((eq ?@ (char-syntax-from-code newval)) ;; class at once
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
433 (put-char-table key value new))))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
434 nil)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
435 old))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 ;; Merge an old abbrev table into a new one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 ;; This function requires internal knowledge of how abbrev tables work,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 ;; presuming that they are obarrays with the abbrev as the symbol, the expansion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 ;; as the value of the symbol, and the hook as the function definition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (defun derived-mode-merge-abbrev-tables (old new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (if old
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
443 (mapatoms
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
444 #'(lambda (symbol)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
445 (or (intern-soft (symbol-name symbol) new)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
446 (define-abbrev new (symbol-name symbol)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
447 (symbol-value symbol) (symbol-function symbol))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 old)))
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
449
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (provide 'derived)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
452 ;;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 ;;; derived.el ends here