comparison lisp/emacs-lisp/lucid.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 4925eba04c46
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; lucid.el --- emulate some Lucid Emacs functions 1 ;;; lucid.el --- emulate some Lucid Emacs functions
2 2
3 ;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc. 3 ;; Copyright (C) 1993, 1995, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Maintainer: FSF 6 ;; Maintainer: FSF
6 ;; Keywords: emulations 7 ;; Keywords: emulations
7 8
8 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
19 20
20 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
27 ;;; Code: 28 ;;; Code:
28 29
29 ;; XEmacs autoloads CL so we might as well make use of it. 30 ;; XEmacs autoloads CL so we might as well make use of it.
30 (require 'cl) 31 (require 'cl)
31 32
32 (defalias 'current-time-seconds 'current-time) 33 (defalias 'current-time-seconds 'current-time)
33
34 (defun map-keymap (function keymap &optional sort-first)
35 "Call FUNCTION for every binding in KEYMAP.
36 This does not include bindings inherited from a parent keymap.
37 FUNCTION receives two arguments each time it is called:
38 the character (more generally, the event type) that is bound,
39 and the binding it has.
40
41 Note that passing the event type directly to `define-key' does not work
42 in Emacs 19. We do not emulate that particular feature of Lucid Emacs.
43 If your code does that, modify it to make a vector containing the event
44 type that you get. That will work in both versions of Emacs."
45 (if sort-first
46 (let (list)
47 (cl-map-keymap (lambda (a b) (push (cons a b) list))
48 keymap)
49 (setq list (sort list
50 (lambda (a b)
51 (setq a (car a) b (car b))
52 (if (integerp a)
53 (if (integerp b) (< a b)
54 t)
55 (if (integerp b) t
56 (string< a b))))))
57 (dolist (p list)
58 (funcall function (car p) (cdr p))))
59 (cl-map-keymap function keymap)))
60 34
61 (defun read-number (prompt &optional integers-only) 35 (defun read-number (prompt &optional integers-only)
62 "Read a number from the minibuffer. 36 "Read a number from the minibuffer.
63 Keep reentering the minibuffer until we get suitable input. 37 Keep reentering the minibuffer until we get suitable input.
64 If optional argument INTEGERS-ONLY is non-nil, insist on an integer." 38 If optional argument INTEGERS-ONLY is non-nil, insist on an integer."
125 99
126 ;; Buffer context 100 ;; Buffer context
127 101
128 (defun buffer-syntactic-context (&optional buffer) 102 (defun buffer-syntactic-context (&optional buffer)
129 "Syntactic context at point in BUFFER. 103 "Syntactic context at point in BUFFER.
130 Either of `string', `comment' or `nil'. 104 Either of `string', `comment' or nil.
131 This is an XEmacs compatibility function." 105 This is an XEmacs compatibility function."
132 (with-current-buffer (or buffer (current-buffer)) 106 (with-current-buffer (or buffer (current-buffer))
133 (let ((state (syntax-ppss (point)))) 107 (let ((state (syntax-ppss (point))))
134 (cond 108 (cond
135 ((nth 3 state) 'string) 109 ((nth 3 state) 'string)
258 (defalias 'x-create-screen 'x-create-frame) 232 (defalias 'x-create-screen 'x-create-frame)
259 (defalias 'x-new-screen 'make-frame) 233 (defalias 'x-new-screen 'make-frame)
260 234
261 (provide 'lucid) 235 (provide 'lucid)
262 236
237 ;;; arch-tag: 80f9ab46-0b36-4151-86ed-3edb6d449c9e
263 ;;; lucid.el ends here 238 ;;; lucid.el ends here