annotate lisp/hm--html-menus/adapt.el @ 177:6075d714658b r20-3b15

Import from CVS: tag r20-3b15
author cvs
date Mon, 13 Aug 2007 09:51:16 +0200
parents 25f70ba0133c
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
177
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
1 ;;; $Id: adapt.el,v 1.5 1997/07/26 22:09:44 steve Exp $
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 ;;;
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
3 ;;; Copyright (C) 1993 - 1997 Heiko Muenkel
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;;; email: muenkel@tnt.uni-hannover.de
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 ;;; This program is free software; you can redistribute it and/or modify
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;;; it under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;;; the Free Software Foundation; either version 2, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;;; This program is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;;; GNU General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;;; You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;;; along with this program; if not, write to the Free Software
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 ;;; Description:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 ;;;
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
23 ;;; General functions to port XEmacs functions to GNU Emacs 19.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 ;;; Installation:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 ;;; Put this file in one of your lisp load directories.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 (defun adapt-xemacsp ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 "Returns non nil if the editor is the XEmacs."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 (or (string-match "Lucid" emacs-version)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 (string-match "XEmacs" emacs-version)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 (defun adapt-lemacsp ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 "Returns non nil if the editor is the XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 Old version, use `adapt-xemacsp' instead of this."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 (or (string-match "Lucid" emacs-version)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 (string-match "XEmacs" emacs-version)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 (defun adapt-emacs19p ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 "Returns non nil if the editor is the GNU Emacs 19."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 (and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 (not (adapt-xemacsp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 (string= (substring emacs-version 0 2) "19")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
50 ;;; Functions, which don't exist in both emacs versions
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 (defun adapt-region-active-p ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 "Returns t, if a region is active."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 (if (adapt-xemacsp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 (mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 mark-active))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
58 (if (not (fboundp 'file-remote-p))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
59 (defun file-remote-p (file)
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
60 "Test wether file resides on the local system.
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
61 The special value 'unknown is returned if no remote file acess package
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
62 has been loaded."
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
63 (if (not (featurep 'ange-ftp))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
64 (require 'ange-ftp))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
65 (if (not (fboundp 'ange-ftp-ftp-p))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
66 nil ; better than nothing, if no ange-ftp-ftp-p exists
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
67 (ange-ftp-ftp-path file))))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
69
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
70 ;;; Functions, which don't exist in the Emacs 19
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 (if (adapt-emacs19p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 (load-library "lucid")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (load-library "lmenu")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 (if window-system
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 (require 'font-lock)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 (make-face 'font-lock-comment-face)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 (defun read-number (prompt &optional integers-only)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 "Reads a number from the minibuffer."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 (let ((error t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 (number nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 (if integers-only
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (while error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 (let ((input-string (read-string prompt)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (setq number (if (string= "" input-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 (read input-string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 (if (integerp number)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 (setq error nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 (while error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 (let ((input-string (read-string prompt)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 (setq number (if (string= "" input-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 (read input-string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 (if (numberp number)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 (setq error nil)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 number))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 (defvar original-read-string-function nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 "Points to the original Emacs 19 function read-string.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 (if (not original-read-string-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 (fset 'original-read-string-function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 (symbol-function 'read-string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 (defun read-string (prompt &optional initial-contents history)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 "Return a string from the minibuffer, prompting with string PROMPT.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 in the minibuffer before reading.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 Third arg HISTORY, if non-nil, specifies a history list."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 (read-from-minibuffer prompt initial-contents nil nil history))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 (defun make-extent (beg end &optional buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 (make-overlay beg end buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 (defun set-extent-property (extent prop value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 (if (eq prop 'duplicable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 (cond ((and value (not (overlay-get extent prop)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 ;; If becoming duplicable,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 ;; copy all overlay props to text props.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 (add-text-properties (overlay-start extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 (overlay-end extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 (overlay-properties extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 (overlay-buffer extent)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 ;; If becoming no longer duplicable, remove these text props.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 ((and (not value) (overlay-get extent prop))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 (remove-text-properties (overlay-start extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 (overlay-end extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 (overlay-properties extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 (overlay-buffer extent))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 ;; If extent is already duplicable, put this property
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 ;; on the text as well as on the overlay.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 (if (overlay-get extent 'duplicable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 (put-text-property (overlay-start extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 (overlay-end extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 prop value (overlay-buffer extent))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 (overlay-put extent prop value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 (defun set-extent-face (extent face)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
146 (set-extent-property extent 'face face))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 (defun delete-extent (extent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 (set-extent-property extent 'duplicable nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 (delete-overlay extent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 ; (defun make-extent (from to &optional buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 ; "Make extent for range [FROM, TO) in BUFFER -- BUFFER defaults to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 ;current buffer. Insertions at point TO will be outside of the extent;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 ;insertions at FROM will be inside the extent (and the extent will grow.).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 ;This is only a simple emulation of the Lucid Emacs extents !"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 ; (list 'extent from to buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 ; (defun set-extent-face (extent face)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 ; "Make the given EXTENT have the graphic attributes specified by FACE.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 ;This is only a simple emulation of the Lucid Emacs extents !"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 ; (put-text-property (car (cdr extent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 ; (car (cdr (cdr extent)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 ; 'face
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 ; face
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 ; (car (cdr (cdr (cdr extent))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 ; (defun delete-extent (extent_obj)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 ; "Remove EXTENT from its buffer; this does not modify the buffer's text,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 ;only its display properties.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 ;This is only a simple emulation of the Lucid Emacs extents !"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 ; (remove-text-properties (car (cdr extent_obj))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173 ; (car (cdr (cdr extent_obj)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 ; (list 'face nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 ; (car (cdr (cdr (cdr extent_obj))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 (if (not (fboundp 'emacs-pid))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 (defun emacs-pid ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 "Return the process ID of Emacs, as an integer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 This is a dummy function for old versions of the Emacs 19.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 You should install a new version, which has `emacs-pid' implemented."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186 (if (not (fboundp 'facep))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 (defun facep (object)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 "Whether OBJECT is a FACE.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 It's only a dummy function in the Emacs 19, which returns always nil."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 ; (if (not (fboundp 'set-extent-property))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 ; (defun set-extent-property (extent property value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 ; "Change a property of an extent.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 ;Only a dummy version in Emacs 19."))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
197 (if (not (fboundp 'region-active-p))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
198 (defun region-active-p ()
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
199 "Non-nil iff the region is active.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
200 If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
201 Otherwise, this function always returns false."
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
202 (adapt-region-active-p)))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
203
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
204 (if (not (fboundp 'next-command-event))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
205 (defun next-command-event (&optional event prompt)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
206 "Unlike the XEmacs version it reads the next event, if
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
207 it is a command event or not.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
208
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
209 Return the next available \"user\" event.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
210 Pass this object to `dispatch-event' to handle it.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
211
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
212 If EVENT is non-nil, it should be an event object and will be filled in
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
213 and returned; otherwise a new event object will be created and returned.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
214 If PROMPT is non-nil, it should be a string and will be displayed in the
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
215 echo area while this function is waiting for an event.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
216
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
217 The event returned will be a keyboard, mouse press, or mouse release event.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
218 If there are non-command events available (mouse motion, sub-process output,
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
219 etc) then these will be executed (with `dispatch-event') and discarded. This
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
220 function is provided as a convenience; it is equivalent to the lisp code
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
221
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
222 (while (progn
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
223 (next-event event prompt)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
224 (not (or (key-press-event-p event)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
225 (button-press-event-p event)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
226 (button-release-event-p event)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
227 (misc-user-event-p event))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
228 (dispatch-event event))"
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
229 (message prompt)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
230 (or event
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
231 (read-event))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
232
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
233 (if (not (fboundp 'button-event-p))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
234 (defun button-event-p (obj)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
235 "True if OBJ is a button-press or button-release event object."
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
236 (and (eventp obj)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
237 (or (eq 'mouse-1 (event-basic-type obj))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
238 (eq 'mouse-2 (event-basic-type obj))
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
239 (eq 'mouse-3 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
240 (eq 'down-mouse-1 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
241 (eq 'down-mouse-2 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
242 (eq 'down-mouse-3 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
243 (eq 'up-mouse-1 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
244 (eq 'up-mouse-2 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
245 (eq 'up-mouse-3 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
246 (eq 'drag-mouse-1 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
247 (eq 'drag-mouse-2 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
248 (eq 'drag-mouse-3 (event-basic-type obj))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
249 ))))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
250
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
251 (if (not (fboundp 'button-drag-event-p))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
252 (defun button-drag-event-p (obj)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
253 "True if OBJ is a mouse-button-drag event object."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
254 (and (button-event-p obj)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
255 (member 'drag (event-modifiers obj)))))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
256
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
257 (if (not (fboundp 'button-press-event-p))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
258 (defun button-press-event-p (obj)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
259 "True if OBJ is a mouse-button-press event object."
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
260 (and (button-event-p obj)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
261 (member 'down (event-modifiers obj)))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
262
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
263 (if (not (fboundp 'button-release-event-p))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
264 (defun button-release-event-p (obj)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
265 "True if OBJ is a mouse-button-release event object."
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
266 (and (button-event-p obj)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
267 (not (button-press-event-p obj)))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
268
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
269 (if (not (fboundp 'button-click-event-p))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
270 (defun button-click-event-p (obj)
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
271 "True if OBJ is a click event obkect."
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
272 ;; only for the Emacs 19
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
273 ;; doesn't exist and can't (?) exist in the XEmacs
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
274 (and (button-event-p obj)
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
275 (member 'click (event-modifiers obj)))))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
276
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
277 (if (not (fboundp 'mouse-event-p))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
278 (defun mouse-event-p (obj)
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
279 "True if OBJ is a button-press, button-release, or mouse-motion event object."
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
280 (or (button-event-p obj)
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
281 (member 'drag (event-modifiers obj)))))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
282
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
283 (if (not (fboundp 'event-window))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
284 (defun event-window (event)
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
285 "Return the window of the given mouse EVENT.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
286 This may be nil if the event occurred in the border or over a toolbar.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
287 The modeline is considered to be in the window it represents.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
288
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
289 If the EVENT is a mouse drag event, then the end event window is returned."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
290 (if (button-drag-event-p event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
291 (and (listp event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
292 (third event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
293 (listp (third event))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
294 (windowp (car (third event)))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
295 (car (third event)))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
296 (and (eventp event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
297 (listp event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
298 (second event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
299 (listp (second event))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
300 (windowp (car (second event)))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
301 (car (second event))))))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
302
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
303 ; (listp (cdr event))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
304 ; (listp (car (cdr event)))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
305 ; (windowp (car (car (cdr event))))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
306 ; (car (car (cdr event))))))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
307
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
308 (if (not (fboundp 'event-buffer))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
309 (defun event-buffer (event)
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
310 "Given a mouse-motion, button-press, or button-release event,
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
311 return the buffer on which that event occurred. This will be nil for
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
312 non-mouse events. If event-over-text-area-p is nil, this will also be nil."
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
313 (if (button-event-p event)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
314 (window-buffer (event-window event)))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
315
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
316
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
317 (if (not (fboundp 'event-closest-point))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
318 (defun event-closest-point (event)
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
319 "Return the character position of the given mouse EVENT.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
320 If the EVENT did not occur over a window or over text, return the
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
321 closest point to the location of the EVENT. If the Y pixel position
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
322 overlaps a window and the X pixel position is to the left of that
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
323 window, the closest point is the beginning of the line containing the
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
324 Y position. If the Y pixel position overlaps a window and the X pixel
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
325 position is to the right of that window, the closest point is the end
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
326 of the line containing the Y position. If the Y pixel position is
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
327 above a window, return 0. If it is below a window, return the value
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
328 of (window-end).
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
329
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
330 If the EVENT is a drag event, the event-end will be used."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
331 (if (button-drag-event-p event)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
332 (posn-point (event-end event))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
333 (posn-point (event-start event)))))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
334
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
335 (if (not (fboundp 'add-minor-mode))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
336 (defun add-minor-mode (toggle
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
337 name
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
338 &optional
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
339 keymap
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
340 after
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
341 toggle-fun)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
342 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
343 TOGGLE is a symbol whose value as a variable specifies whether the
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
344 minor mode is active. NAME is the name that should appear in the
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
345 modeline (it should be a string beginning with a space). KEYMAP is a
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
346 keymap to make active when the minor mode is active. AFTER is the
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
347 toggling symbol used for another minor mode. If AFTER is non-nil,
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
348 then it is used to position the new mode in the minor-mode alists.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
349
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
350 TOGGLE-FUN is only a dummy variable in the Emacs 19. In the XEmacs
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
351 it has the following description:
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
352 TOGGLE-FUN specifies an interactive function that is called to toggle
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
353 the mode on and off; this affects what happens when button2 is pressed
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
354 on the mode, and when button3 is pressed somewhere in the list of
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
355 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function,
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
356 TOGGLE is used as the toggle function.
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
357
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
358 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
359
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
360 WARNING: THIS FUNCTION ISN'T READ YET."
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
361 (if after
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
362 (add-minor-mode-1 toggle name keymap after)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
363 (if (not (assq toggle minor-mode-alist))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
364 (progn
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
365 (setq minor-mode-alist
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
366 (cons (list toggle name)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
367 minor-mode-alist))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
368 (if (not (assq toggle minor-mode-map-alist))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
369 (progn
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
370 (setq minor-mode-map-alist
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
371 (cons (cons toggle keymap)
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
372 minor-mode-map-alist))))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
373 ))
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
374 )
98
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
375
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
376 (if (not (fboundp 'redraw-modeline))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
377 (defalias 'redraw-modeline 'force-mode-line-update))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
378
116
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
379 (if (not (fboundp 'mouse-track))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
380 (defalias 'mouse-track 'mouse-drag-region))
9f59509498e1 Import from CVS: tag r20-1b10
cvs
parents: 98
diff changeset
381
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
382 (if (not (fboundp 'windows-of-buffer))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
383 (defun windows-of-buffer (&optional buffer)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
384 "Returns a list of windows that have BUFFER in them.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
385 If BUFFER is not specified, the current buffer will be used."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
386 (get-buffer-window-list buffer)))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
387
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
388 (if (not (boundp 'help-selects-help-window))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
389 (defvar help-selects-help-window t
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
390 "*If nil, use the \"old Emacs\" behavior for Help buffers.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
391 This just displays the buffer in another window, rather than selecting
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
392 the window."))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
393
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
394 (if (not (fboundp 'with-displaying-help-buffer))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
395 (defun with-displaying-help-buffer (thunk)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
396 (let ((winconfig (current-window-configuration))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
397 (was-one-window (one-window-p))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
398 (help-not-visible
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
399 (not (and (windows-of-buffer "*Help*") ;shortcut
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
400 (member (selected-frame)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
401 (mapcar 'window-frame
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
402 (windows-of-buffer "*Help*")))))))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
403 (prog1 (with-output-to-temp-buffer "*Help*"
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
404 (prog1 (funcall thunk)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
405 (save-excursion
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
406 (set-buffer standard-output)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
407 (help-mode))))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
408 (let ((helpwin (get-buffer-window "*Help*")))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
409 (if helpwin
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
410 (progn
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
411 (save-excursion
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
412 (set-buffer (window-buffer helpwin))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
413 ;;If the *Help* buffer is already displayed on this
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
414 ;; frame, don't override the previous configuration
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
415 ; (if help-not-visible
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
416 ; (set-frame-property
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
417 ; (selected-frame)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
418 ; 'help-window-config winconfig)))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
419 )
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
420 (if help-selects-help-window
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
421 (select-window helpwin))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
422 (cond ((eq helpwin (selected-window))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
423 (message
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
424 (substitute-command-keys
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
425 "\\[scroll-up] to scroll the help."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
426 )))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
427 (was-one-window
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
428 (message
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
429 (substitute-command-keys
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
430 "\\[scroll-other-window] to scroll the help."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
431 )))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
432 (t
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
433 (message
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
434 (substitute-command-keys
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
435 "\\[scroll-other-window] to scroll the help."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
436 )))))))))))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
437
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
438 (if (not (fboundp 'set-extent-mouse-face))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
439 (defun set-extent-mouse-face (extent face)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
440 "Set the face used to highlight EXTENT when the mouse passes over it.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
441 FACE can also be a list of faces, and all faces listed will apply,
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
442 with faces earlier in the list taking priority over those later in the
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
443 list.
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
444
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
445 In the Emacs 19, the argument FACE could not be a list of faces."
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
446 (put-text-property (overlay-start extent)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
447 (overlay-end extent)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
448 'mouse-face face)
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
449 ))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
450
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
451
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
452 (if (not (fboundp 'read-directory-name))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
453 (defalias 'read-directory-name 'read-file-name))
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
454
177
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
455 (if (not (fboundp 'define-obsolete-function-alias))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
456 (defsubst define-obsolete-function-alias (oldfun newfun)
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
457 "Define OLDFUN as an obsolete alias for function NEWFUN.
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
458 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
459 as obsolete."
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
460 (define-function oldfun newfun)
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
461 (make-obsolete oldfun newfun)))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
462
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
463 (if (not (fboundp 'define-obsolete-variable-alias))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
464 (defsubst define-obsolete-variable-alias (oldvar newvar)
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
465 "Define OLDVAR as an obsolete alias for varction NEWVAR.
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
466 This makes referencing or setting OLDVAR equivalent to referencing or
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
467 setting NEWVAR and marks OLDVAR as obsolete.
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
468
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
469 It is not full implemented in the Emacs 19, because of the lack of
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
470 the function defvaralias.y"
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
471 ;;(defvaralias oldvar newvar) <- doesn't exist in the Emacs 19.34
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
472 (make-obsolete-variable oldvar newvar)))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
473
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
474 (if (not (fboundp 'defgroup))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
475 (defmacro defgroup (symbol members doc &rest args)
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
476 "Dummy definition. Used, if the custom package isn't installed.
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
477 The dummy definition makes nothing, it returns only nil."
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
478 nil))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
479
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
480 (if (not (fboundp 'defcustom))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
481 (defmacro defcustom (symbol value doc &rest args)
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
482 "Simulates the defcustom definition from the custom package.
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
483 It calles a `defvar' with the arguments SYMBOL, VALUE and DOC."
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
484 `(defvar ,symbol ,value ,doc)))
6075d714658b Import from CVS: tag r20-3b15
cvs
parents: 153
diff changeset
485
153
25f70ba0133c Import from CVS: tag r20-3b3
cvs
parents: 116
diff changeset
486
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
487 ))
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
488
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
489
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
490 (provide 'adapt)