annotate lisp/derived.el @ 4882:eab9498ecc0e

merge most of rest of redisplay-x.c and redisplay-gtk.c into redisplay-xlike-inc.c -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-01-18 Ben Wing <ben@xemacs.org> * redisplay-gtk.c: * redisplay-gtk.c (gtk_bevel_area): * redisplay-x.c: * redisplay-x.c (THIS_IS_X): * redisplay-xlike-inc.c: * redisplay-xlike-inc.c (XLIKE_text_width_single_run): * redisplay-xlike-inc.c (XLIKE_text_width): * redisplay-xlike-inc.c (XLIKE_output_display_block): * redisplay-xlike-inc.c (XLIKE_get_gc): * redisplay-xlike-inc.c (XLIKE_output_string): * redisplay-xlike-inc.c (XLIKE_OUTPUT_XLIKE_PIXMAP): * redisplay-xlike-inc.c (XLIKE_output_pixmap): * redisplay-xlike-inc.c (XLIKE_output_vertical_divider): * redisplay-xlike-inc.c (XLIKE_output_blank): * redisplay-xlike-inc.c (XLIKE_output_horizontal_line): * redisplay-xlike-inc.c (XLIKE_clear_region): * redisplay-xlike-inc.c (XLIKE_output_eol_cursor): * redisplay-xlike-inc.c (XLIKE_clear_frame_window): * redisplay-xlike-inc.c (XLIKE_clear_frame): * redisplay-xlike-inc.c (XLIKE_flash): * redisplay-xlike-inc.c (console_type_create_redisplay_XLIKE): Move lots more code into redisplay-xlike-inc.c. Use macros to isolate the code that differs among X vs. GTK, to reduce the need for ifdefs in the middle of the code. Now, redisplay-x.c and redisplay-gtk.c only contain a few functions whose implementation is completely different from one to the other, or which are not present at all in one of them. GTK code not currently tested, but it has bitrotted somewhat any. Doing this will help keep it less bitrotty. * depend: Regenerate.
author Ben Wing <ben@xemacs.org>
date Mon, 18 Jan 2010 08:44:49 -0600
parents 04a435415e1d
children 308d34e9f07d
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
27 ;;; Synched up with: FSF 21.3.
428
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 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 428
diff changeset
33 ;; XEmacs is already, in a sense, object oriented -- each object
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; (buffer) belongs to a class (major mode), and that class defines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; the relationship between messages (input events) and methods
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; (commands) by means of a keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; The only thing missing is a good scheme of inheritance. It is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; possible to simulate a single level of inheritance with generous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; 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
41 ;; the hooks for text-mode, and keymaps can inherit from other keymaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; -- but generally, each major mode ends up reinventing the wheel.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; Ideally, someone should redesign all of Emacs's major modes to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; follow a more conventional object-oriented system: when defining a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; 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
46 ;; it is most similar to, then list the (few) differences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; In the mean time, this package offers most of the advantages of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; full inheritance with the existing major modes. The macro
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; `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
51 ;; 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
52 ;; bindings of its parent, and will, in fact, run its parent first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; every time it is called. For example, the commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; (define-derived-mode hypertext-mode text-mode "Hypertext"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; (setq case-fold-search nil))
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 ;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; 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
62 ;; keymap `hypertext-mode-map'. The command M-x hypertext-mode will
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; perform the following actions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; - 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
66 ;; - replace the current keymap with 'hypertext-mode-map', which will
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; inherit from 'text-mode-map'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; - replace the current syntax table with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; 'hypertext-mode-syntax-table', which will borrow its defaults
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; from the current text-mode-syntax-table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; - replace the current abbrev table with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;; 'hypertext-mode-abbrev-table', which will borrow its defaults
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; from the current text-mode-abbrev table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; - change the mode line to read "Hypertext"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; - assign the value 'hypertext-mode' to the 'major-mode' variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; - run the body of commands provided in the macro -- in this case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; set the local variable `case-fold-search' to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; 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
80 ;; 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
81 ;; possibly using hooks, you would have added it to all text buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; -- here, it appears only in hypertext buffers, where it makes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; sense. Second, it is possible to build even further, and make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; a derived mode from a derived mode. The commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;; (define-derived-mode html-mode hypertext-mode "HTML")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;; [various key definitions]
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
88 ;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; will add a new major mode for HTML with very little fuss.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;;
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
91 ;; 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
92 ;; 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
93 ;; (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
94 ;; be used in place of (eq major-mode 'text-mode).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
98 ;;; 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
99
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
100 (defsubst derived-mode-hook-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
101 "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
102 (intern (concat (symbol-name mode) "-hook")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
103
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
104 (defsubst derived-mode-map-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
105 "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
106 (intern (concat (symbol-name mode) "-map")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
107
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
108 (defsubst derived-mode-syntax-table-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
109 "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
110 (intern (concat (symbol-name mode) "-syntax-table")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
111
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
112 (defsubst derived-mode-abbrev-table-name (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
113 "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
114 (intern (concat (symbol-name mode) "-abbrev-table")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
115
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 ;; PUBLIC: define a new major mode which inherits from an existing one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 ;; XEmacs -- no autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (defmacro define-derived-mode (child parent name &optional docstring &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 "Create a new mode as a variant of an existing mode.
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 The arguments to this command are as follow:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 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
125 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
126 or nil if there is no parent.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
127 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
128 DOCSTRING: an optional documentation string--if you do not supply one,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 the function will attempt to invent something useful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 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
131 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
132
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
133 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
134 arguments are currently understood:
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
135 :group GROUP
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
136 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
137 :syntax-table TABLE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
138 Use TABLE instead of the default.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
139 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
140 :abbrev-table TABLE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
141 Use TABLE instead of the default.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
142 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
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 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
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 You could then make new key bindings for `LaTeX-thesis-mode-map'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 without changing regular LaTeX mode. In this example, BODY is empty,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 and DOCSTRING is generated by default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
152 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
153 the parent, and then sets the variable `case-fold-search' to nil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (define-derived-mode article-mode sgml-mode \"Article\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 \"Major mode for editing technical articles.\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (setq case-fold-search nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 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
160 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
161
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
162 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
163 `derived-mode-hook-name'."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
164 (declare (debug (&define name symbolp sexp [&optional stringp]
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
165 [&rest keywordp sexp] def-body)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
166
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
167 (when (and docstring (not (stringp docstring)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
168 ;; 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
169 ;; the first element of the body.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
170 (push docstring body)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
171 (setq docstring 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 (when (eq parent 'fundamental-mode) (setq parent nil))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
174
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
175 (let ((map (derived-mode-map-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
176 (syntax (derived-mode-syntax-table-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
177 (abbrev (derived-mode-abbrev-table-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
178 (declare-abbrev t)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
179 (declare-syntax t)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
180 (hook (derived-mode-hook-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
181 (group nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
183 ;; Process the keyword args.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
184 (while (keywordp (car body))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
185 (case (pop body)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
186 (:group (setq group (pop body)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
187 (: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
188 (: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
189 (t (pop body))))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
190
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
191 (setq docstring (derived-mode-make-docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
192 parent child docstring syntax abbrev))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
194 `(progn
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
195 (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
196 (defvar ,map (make-sparse-keymap))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
197 ,(if declare-syntax
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
198 `(defvar ,syntax (make-syntax-table)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
199 ,(if declare-abbrev
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
200 `(defvar ,abbrev
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
201 (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
202 (put ',child 'derived-mode-parent ',parent)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
203 ,(if group `(put ',child 'custom-mode-group ,group))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
204
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (defun ,child ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ,docstring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ; Run the parent.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
209 (delay-mode-hooks
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
210
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
211 (,(or parent 'kill-all-local-variables))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
212 ; Identify the child mode.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
213 (setq major-mode (quote ,child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
214 (setq mode-name ,name)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 ; Identify special modes.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
216 ,(when parent
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
217 `(progn
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
218 (if (get (quote ,parent) 'mode-class)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
219 (put (quote ,child) 'mode-class
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
220 (get (quote ,parent) 'mode-class)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 ; Set up maps and tables.
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
222 (unless (keymap-parent ,map)
2140
9da6e6c569f7 [xemacs-hg @ 2004-06-18 04:06:49 by james]
james
parents: 2135
diff changeset
223 (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
224 ,(when declare-syntax
2140
9da6e6c569f7 [xemacs-hg @ 2004-06-18 04:06:49 by james]
james
parents: 2135
diff changeset
225 ;; 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
226 `(derived-mode-merge-syntax-tables
2142
eb65d362090f [xemacs-hg @ 2004-06-18 15:48:38 by james]
james
parents: 2140
diff changeset
227 (syntax-table) ,syntax))))
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
228
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
229 (use-local-map ,map)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
230 ,(when syntax `(set-syntax-table ,syntax))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
231 ,(when abbrev `(setq local-abbrev-table ,abbrev))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 ; Splice in the body (if any).
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
233 ,@body
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
234 )
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
235 ;; Run the hooks, if any.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
236 ;; 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
237 ;; that do not yet have run-mode-hooks.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
238 (if (fboundp 'run-mode-hooks)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
239 (run-mode-hooks ',hook)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
240 (run-hooks ',hook))))))
428
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 ;; PUBLIC: find the ultimate class of a derived mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (defun derived-mode-class (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
245 "Find the class of a major MODE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 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
247 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
248 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
249 is not very useful."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (while (get mode 'derived-mode-parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (setq mode (get mode 'derived-mode-parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
253 (make-obsolete 'derived-mode-class 'derived-mode-p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
906
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
255 ;; 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
256 ;; from GNU Emacs 21 subr.el
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
257
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
258 (defun derived-mode-p (&rest modes)
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
259 "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
260 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
261 (let ((parent major-mode))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
262 (while (and (not (memq parent modes))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
263 (setq parent (get parent 'derived-mode-parent))))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
264 parent))
7f5ac0d2a71f [xemacs-hg @ 2002-07-08 08:21:47 by youngs]
youngs
parents: 613
diff changeset
265
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
267 ;;; PRIVATE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
268
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
269 (defun derived-mode-make-docstring (parent child &optional
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
270 docstring syntax abbrev)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
271 "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
272
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
273 (let ((map (derived-mode-map-name child))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
274 (hook (derived-mode-hook-name child)))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
275
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
276 (unless (stringp docstring)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
277 ;; Use a default docstring.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
278 (setq docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
279 (if (null parent)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
280 (format "Major-mode.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
281 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
282 (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
283 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
284 abbrev table and syntax table:
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 `%s', `%s' and `%s'
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
287
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
288 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
289 parent map abbrev syntax parent))))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
290
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
291 (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
292 ;; 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
293 (setq docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
294 (concat docstring
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
295 (if (null parent)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
296 "\n\nThis mode "
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
297 (concat
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
298 "\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
299 (if (string-match (regexp-quote (format "`%s'" parent))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
300 docstring) nil
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
301 (format "`%s' " parent))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
302 "might have run,\nthis mode "))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
303 (format "runs the hook `%s'" hook)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
304 ", as the final step\nduring initialization.")))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
305
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
306 (unless (string-match "\\\\[{[]" docstring)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
307 ;; 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
308 (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
309
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
310 docstring))
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
311
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
312
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
313 ;;; OBSOLETE
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
314 ;; 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
315 ;; 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
316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (defsubst derived-mode-setup-function-name (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
318 "Construct a setup-function name based on a MODE name."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (intern (concat (symbol-name mode) "-setup")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
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 ;; Utility functions for defining a derived mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 ;; XEmacs -- don't autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (defun derived-mode-init-mode-variables (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
326 "Initialise variables for a new MODE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 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
328 empty syntax table, and an empty abbrev table -- these will be merged
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 the first time the mode is used."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (if (boundp (derived-mode-map-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (eval `(defvar ,(derived-mode-map-name mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (make-sparse-keymap (derived-mode-map-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 ,(format "Keymap for %s." mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (if (boundp (derived-mode-syntax-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (eval `(defvar ,(derived-mode-syntax-table-name mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 ;; Make a syntax table which doesn't specify anything
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 ;; for any char. Valid data will be merged in by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 ;; derived-mode-merge-syntax-tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; (make-char-table 'syntax-table nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (make-syntax-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 ,(format "Syntax table for %s." mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (if (boundp (derived-mode-abbrev-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (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
354 (progn
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
355 (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
356 (make-abbrev-table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 ,(format "Abbrev table for %s." 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 ;; Utility functions for running a derived mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (defun derived-mode-set-keymap (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
362 "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
363 (let* ((map-name (derived-mode-map-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (new-map (eval map-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (old-map (current-local-map)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (and old-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (get map-name 'derived-mode-unmerged)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (derived-mode-merge-keymaps old-map new-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (put map-name 'derived-mode-unmerged nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (use-local-map new-map)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
372 (defun derived-mode-set-syntax-table (mode)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
373 "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
374 (let* ((table-name (derived-mode-syntax-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (old-table (syntax-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (new-table (eval table-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (if (get table-name 'derived-mode-unmerged)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (derived-mode-merge-syntax-tables old-table new-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (put table-name 'derived-mode-unmerged nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (set-syntax-table new-table)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (defun derived-mode-set-abbrev-table (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
383 "Set the abbrev table for MODE if it exists.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 Always merge its parent into it, since the merge is non-destructive."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (let* ((table-name (derived-mode-abbrev-table-name mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (old-table local-abbrev-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (new-table (eval table-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (derived-mode-merge-abbrev-tables old-table new-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (setq local-abbrev-table new-table)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 ;;;(defun derived-mode-run-setup-function (mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 ;;; "Run the setup function if it exists."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 ;;; (let ((fname (derived-mode-setup-function-name mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 ;;; (if (fboundp fname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ;;; (funcall fname))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (defun derived-mode-run-hooks (mode)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
399 "Run the mode hook for MODE."
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
400 (let ((hooks-name (derived-mode-hook-name mode)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (if (boundp hooks-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (run-hooks hooks-name))))
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 ;; Functions to merge maps and tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (defun derived-mode-merge-keymaps (old new)
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
407 "Merge an OLD keymap into a NEW one.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
408 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
409 be automatic inheritance."
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
410 ;; 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
411 ;; for merging prefix keys and such. Hopefully none of this is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ;; necessary in XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (set-keymap-parents new (list old)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (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
416 "Merge an OLD syntax table into a NEW one.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 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
418 ;; 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
419 ;; (set-char-table-parent new old) here.
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
420 ;; 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
421 ;; check for inheritance.
3163
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
422 (map-char-table
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
423 #'(lambda (key value)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
424 (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
425 (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
426 (map-char-table
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
427 #'(lambda (key1 value1)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
428 (when (eq ?@ (char-syntax-from-code
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
429 (get-range-char-table key new ?@)))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
430 (put-char-table key1 value new))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
431 nil)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
432 new
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
433 key))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
434 ((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
435 (put-char-table key value new))))
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
436 nil)
04a435415e1d [xemacs-hg @ 2005-12-23 11:42:32 by stephent]
stephent
parents: 3162
diff changeset
437 old))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 ;; Merge an old abbrev table into a new one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 ;; This function requires internal knowledge of how abbrev tables work,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 ;; 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
442 ;; 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
443 (defun derived-mode-merge-abbrev-tables (old new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (if old
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
445 (mapatoms
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
446 #'(lambda (symbol)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
447 (or (intern-soft (symbol-name symbol) new)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
448 (define-abbrev new (symbol-name symbol)
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
449 (symbol-value symbol) (symbol-function symbol))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 old)))
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
451
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (provide 'derived)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453
2135
e6d43c299b9c [xemacs-hg @ 2004-06-17 03:01:10 by james]
james
parents: 1578
diff changeset
454 ;;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 ;;; derived.el ends here