Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/adapt.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; $Id: adapt.el,v 1.1.1.1 1996/12/18 03:34:31 steve Exp $
2 ;;;
3 ;;; Copyright (C) 1993, 1994, 1995 Heiko Muenkel
4 ;;; email: muenkel@tnt.uni-hannover.de
5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 2, or (at your option)
9 ;;; any later version.
10 ;;;
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with this program; if not, write to the Free Software
18 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 ;;;
20 ;;;
21 ;;; Description:
22 ;;;
23 ;;; General functions to port Lucid Emacs to GNU Emacs 19.
24 ;;;
25 ;;; Installation:
26 ;;;
27 ;;; Put this file in one of your lisp load directories.
28 ;;;
29
30
31 (defun adapt-xemacsp ()
32 "Returns non nil if the editor is the XEmacs."
33 (or (string-match "Lucid" emacs-version)
34 (string-match "XEmacs" emacs-version)))
35
36
37 (defun adapt-lemacsp ()
38 "Returns non nil if the editor is the XEmacs.
39 Old version, use `adapt-xemacsp' instead of this."
40 (or (string-match "Lucid" emacs-version)
41 (string-match "XEmacs" emacs-version)))
42
43
44 (defun adapt-emacs19p ()
45 "Returns non nil if the editor is the GNU Emacs 19."
46 (and
47 (not (adapt-xemacsp))
48 (string= (substring emacs-version 0 2) "19")))
49
50 ;;; Functions, which doesn't exist in both emacses
51
52 (defun adapt-region-active-p ()
53 "Returns t, if a region is active."
54 (if (adapt-xemacsp)
55 (mark)
56 mark-active))
57
58
59 (if (adapt-emacs19p)
60 (progn
61 (load-library "lucid")
62
63 (load-library "lmenu")
64
65 (if window-system
66 (require 'font-lock)
67 )
68
69 (make-face 'font-lock-comment-face)
70
71 (defun read-number (prompt &optional integers-only)
72 "Reads a number from the minibuffer."
73 (interactive)
74 (let ((error t)
75 (number nil))
76 (if integers-only
77 (while error
78 (let ((input-string (read-string prompt)))
79 (setq number (if (string= "" input-string)
80 nil
81 (read input-string)))
82 (if (integerp number)
83 (setq error nil))))
84 (while error
85 (let ((input-string (read-string prompt)))
86 (setq number (if (string= "" input-string)
87 nil
88 (read input-string)))
89 (if (numberp number)
90 (setq error nil)))))
91 number))
92
93 (defvar original-read-string-function nil
94 "Points to the original Emacs 19 function read-string.")
95
96 (if (not original-read-string-function)
97 (fset 'original-read-string-function
98 (symbol-function 'read-string)))
99
100 (defun read-string (prompt &optional initial-contents history)
101 "Return a string from the minibuffer, prompting with string PROMPT.
102 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
103 in the minibuffer before reading.
104 Third arg HISTORY, if non-nil, specifies a history list."
105 (read-from-minibuffer prompt initial-contents nil nil history))
106
107 (defun make-extent (beg end &optional buffer)
108 (make-overlay beg end buffer))
109
110 (defun set-extent-property (extent prop value)
111 (if (eq prop 'duplicable)
112 (cond ((and value (not (overlay-get extent prop)))
113 ;; If becoming duplicable,
114 ;; copy all overlay props to text props.
115 (add-text-properties (overlay-start extent)
116 (overlay-end extent)
117 (overlay-properties extent)
118 (overlay-buffer extent)))
119 ;; If becoming no longer duplicable, remove these text props.
120 ((and (not value) (overlay-get extent prop))
121 (remove-text-properties (overlay-start extent)
122 (overlay-end extent)
123 (overlay-properties extent)
124 (overlay-buffer extent))))
125 ;; If extent is already duplicable, put this property
126 ;; on the text as well as on the overlay.
127 (if (overlay-get extent 'duplicable)
128 (put-text-property (overlay-start extent)
129 (overlay-end extent)
130 prop value (overlay-buffer extent))))
131 (overlay-put extent prop value))
132
133 (defun set-extent-face (extent face)
134 (set-extent-property extent 'face face))
135
136 (defun delete-extent (extent)
137 (set-extent-property extent 'duplicable nil)
138 (delete-overlay extent))
139
140 ; (defun make-extent (from to &optional buffer)
141 ; "Make extent for range [FROM, TO) in BUFFER -- BUFFER defaults to
142 ;current buffer. Insertions at point TO will be outside of the extent;
143 ;insertions at FROM will be inside the extent (and the extent will grow.).
144 ;This is only a simple emulation of the Lucid Emacs extents !"
145 ; (list 'extent from to buffer))
146 ;
147 ; (defun set-extent-face (extent face)
148 ; "Make the given EXTENT have the graphic attributes specified by FACE.
149 ;This is only a simple emulation of the Lucid Emacs extents !"
150 ; (put-text-property (car (cdr extent))
151 ; (car (cdr (cdr extent)))
152 ; 'face
153 ; face
154 ; (car (cdr (cdr (cdr extent))))))
155 ;
156 ; (defun delete-extent (extent_obj)
157 ; "Remove EXTENT from its buffer; this does not modify the buffer's text,
158 ;only its display properties.
159 ;This is only a simple emulation of the Lucid Emacs extents !"
160 ; (remove-text-properties (car (cdr extent_obj))
161 ; (car (cdr (cdr extent_obj)))
162 ; (list 'face nil)
163 ; (car (cdr (cdr (cdr extent_obj))))))
164 ;
165
166 (if (not (fboundp 'emacs-pid))
167 (defun emacs-pid ()
168 "Return the process ID of Emacs, as an integer.
169 This is a dummy function for old versions of the Emacs 19.
170 You should install a new version, which has `emacs-pid' implemented."
171 0)
172 )
173
174 (if (not (fboundp 'facep))
175 (defun facep (object)
176 "Whether OBJECT is a FACE.
177 It's only a dummy function in the Emacs 19, which returns always nil."
178 nil))
179
180 ; (if (not (fboundp 'set-extent-property))
181 ; (defun set-extent-property (extent property value)
182 ; "Change a property of an extent.
183 ;Only a dummy version in Emacs 19."))
184
185 ))
186
187
188 (provide 'adapt)