Mercurial > emacs
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 |