[lice @ more rearranging. define-key modifications to accomodate bindings.lisp. this...
authortailor <sabetts@vcn.bc.ca>
Fri, 11 May 2007 18:11:33 +0000 (11 18:11 +0000)
committertailor <sabetts@vcn.bc.ca>
Fri, 11 May 2007 18:11:33 +0000 (11 18:11 +0000)
25 files changed:
src/buffer-local.lisp
src/buffer.lisp
src/callproc.lisp [new file with mode: 0644]
src/casefiddle.lisp
src/cmds.lisp
src/data-types.lisp
src/data.lisp [new file with mode: 0644]
src/debugger.lisp
src/dired.lisp [new file with mode: 0644]
src/editfns.lisp
src/elisp.lisp
src/emacs-lisp/easy-mmode.lisp [new file with mode: 0644]
src/emacs.lisp [new file with mode: 0644]
src/fns.lisp [new file with mode: 0644]
src/global.lisp
src/indent.lisp
src/keyboard.lisp
src/keymap.lisp
src/lice.asd
src/lisp/bindings.lisp [new file with mode: 0644]
src/lisp/subr.lisp
src/main.lisp
src/recursive-edit.lisp
src/search.lisp
src/window.lisp

index 551701a..b2e652e 100644 (file)
@@ -122,6 +122,10 @@ The default value is seen in buffers that do not have their own values
 for this variable."
   (setf (default-value symbol) value))
 
+(defmacro setq-default (var value)
+  "Set the default value of variable var to value."
+  `(setf (default-value ',var) ,value))
+
 \f
 ;;; Some built-in buffer local variables
 
index 1a4021e..edf2175 100644 (file)
@@ -588,6 +588,21 @@ means that other_buffer is more likely to choose a relevant buffer."
   (when (buffer-read-only)
     (signal 'buffer-read-only)))
 
+(defun buffer-modified-p (&optional (buffer (current-buffer)))
+  "Return t if BUFFER was modified since its file was last read or saved.
+No argument or nil as argument means use current buffer as BUFFER."
+  (slot-value buffer 'modified-p))
+
+(defun (setf buffer-modified-p) (flag &optional (buf (current-buffer)))
+  "Mark current buffer as modified or unmodified according to FLAG.
+A non-nil FLAG means mark the buffer modified."
+  (setf (slot-value buf 'modified-p) (and flag t)))
+
+(defun set-buffer-modified-p (flag)
+  "Mark current buffer as modified or unmodified according to FLAG.
+A non-nil FLAG means mark the buffer modified."
+  (setf (buffer-modified-p) flag))
+
 (defun bufferp (object)
   "Return t if object is an editor buffer."
   (typep object 'buffer))
@@ -673,7 +688,9 @@ Note that this is overridden by the variable
 and this buffer is not full-frame width.")
 (make-variable-buffer-local 'truncate-lines)
 
-
+(define-buffer-local case-fold-search nil
+  "*Non-nil if searches and matches should ignore case.")
+(make-variable-buffer-local 'case-fold-search)
 
 (defun make-buffer-string (start end props &optional (buffer (current-buffer)))
   "Making strings from buffer contents.
@@ -703,4 +720,9 @@ buffer substrings."
              (buffer-char-to-aref buffer start)
              (1+ (buffer-char-to-aref buffer (1- end)))))))
 
+;;; Key bindings
+
+(define-key *ctl-x-map* "b" 'switch-to-buffer)
+(define-key *ctl-x-map* "k" 'kill-buffer)
+
 (provide :lice-0.1/buffer)
diff --git a/src/callproc.lisp b/src/callproc.lisp
new file mode 100644 (file)
index 0000000..259b82c
--- /dev/null
@@ -0,0 +1,57 @@
+;; Synchronous subprocess invocation for GNU Emacs.
+
+(in-package "LICE")
+
+;; FIXME: Fill these with real values
+
+(defvar shell-file-name nil
+"*File name to load inferior shells from.
+Initialized from the SHELL environment variable, or to a system-dependent
+default if SHELL is not set.")
+
+(defvar exec-path nil
+"*List of directories to search programs to run in subprocesses.
+Each element is a string (directory name) or nil (try default directory).")
+
+(defvar exec-suffixes nil
+"*List of suffixes to try to find executable file names.
+Each element is a string.")
+  Vexec_suffixes = Qnil;
+
+(defvar exec-directory nil
+"Directory for executables for Emacs to invoke.
+More generally, this includes any architecture-dependent files
+that are built and installed from the Emacs distribution.")
+
+(defvar data-directory nil
+"Directory of machine-independent files that come with GNU Emacs.
+These are files intended for Emacs to use while it runs.")
+
+(defvar doc-directory nil
+"Directory containing the DOC file that comes with GNU Emacs.
+This is usually the same as `data-directory'.")
+
+(defvar configure-info-directory nil
+"For internal use by the build procedure only.
+This is the name of the directory in which the build procedure installed
+Emacs's info files; the default value for `Info-default-directory-list'
+includes this.")
+
+(defvar shared-game-score-directory nil
+"Directory of score files for games which come with GNU Emacs.
+If this variable is nil, then Emacs is unable to use a shared directory.")
+
+(defvar temp-file-name-pattern nil
+"Pattern for making names for temporary files.
+This is used by `call-process-region'.")
+
+(defvar process-environment nil
+"List of environment variables for subprocesses to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+If multiple entries define the same variable, the first one always
+takes precedence.
+The environment which Emacs inherits is placed in this variable
+when Emacs starts.
+Non-ASCII characters are encoded according to the initial value of
+`locale-coding-system', i.e. the elements must normally be decoded for use.
+See `setenv' and `getenv'.")
index 6b7d8be..deedaab 100644 (file)
@@ -33,9 +33,11 @@ The argument object is not altered--the value is a copy."
 (defun upcase-region (beg end)
   (declare (ignore beg end))
   (error "Unimplemented"))  
+(setf (get 'upcase-region 'disabled) t)
 
 (defun downcase-region ()
   (error "Unimplemented"))
+(setf (get 'downcase-region 'disabled) t)
 
 (defun capitalize-region ()
   (error "Unimplemented"))
@@ -51,3 +53,11 @@ The argument object is not altered--the value is a copy."
 
 (defun capitalize-word ()
   (error "Unimplemented"))
+
+;;; Key bindings
+
+(define-key *ctl-x-map* "C-u" 'upcase-region)
+(define-key *ctl-x-map* "C-l" 'downcase-region)
+(define-key *global-map* "M-u" 'upcase-word)
+(define-key *global-map* "M-l" 'downcase-word)
+(define-key *global-map* "M-c" 'capitalize-word)
index 768d4ed..cfea3c6 100644 (file)
@@ -96,3 +96,26 @@ Whichever character you type to run this command is inserted."
     (when (> arg 0)
       (insert-move-point (current-buffer) (key-char *current-event*)))))
 
+;;; Key bindings
+
+(define-key *global-map* "C-i" 'self-insert-command)
+
+(loop for i in '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+                 #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j
+                 #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t
+                 #\u #\v #\w #\x #\y #\z 
+                 #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J
+                 #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T
+                 #\U #\V #\W #\X #\Y #\Z
+                 #\Space #\! #\" #\# #\$ #\% #\& #\' #\( 
+                 #\) #\* #\+ #\, #\- #\. #\/ #\: #\; #\< 
+                 #\= #\> #\? #\@ #\[ #\\ #\] #\^ #\_ #\` 
+                 #\| #\} #\~ #\{)
+   do (define-key *global-map* (make-key :char i) 'self-insert-command))
+
+(define-key *global-map* "C-a" 'beginning-of-line)
+(define-key *global-map* "C-b" 'backward-char)
+(define-key *global-map* "C-d" 'delete-char)
+(define-key *global-map* "C-e" 'end-of-line)
+(define-key *global-map* "C-f" 'forward-char)
+(define-key *global-map* "DEL" 'delete-backward-char)
\ No newline at end of file
index 7a8a5a2..13a7c42 100644 (file)
@@ -68,7 +68,7 @@
   ((file :type (or null pathname) :initarg :file :accessor buffer-file)
    (name :type string :initarg :name :accessor buffer-name)
    (mode-line-string :type string :initform "" :accessor buffer-mode-line-string)
-   (modified :type boolean :initform nil :accessor buffer-modified-p)
+   (modified-p :type boolean :initform nil)
    (read-only :type boolean :initform nil)
    (tick :type integer :initform 0 :accessor buffer-modified-tick :documentation
         "The buffer's tick counter. It is incremented for each change
diff --git a/src/data.lisp b/src/data.lisp
new file mode 100644 (file)
index 0000000..3825e66
--- /dev/null
@@ -0,0 +1,45 @@
+;;; data.lisp --- compatibility functions from emacs
+
+(in-package "LICE")
+
+(defun % (number divisor)
+  "same as mod."
+  (mod number divisor))
+
+(defun setcar (cell newcar)
+  "Set the car of cell to be newcar.  Returns newcar."
+  (setf (car cell) newcar))
+
+(depricate aset (setf aref))
+(defun aset (array idx newelt)
+  "Store into the element of ARRAY at index IDX the value NEWELT.
+Return NEWELT.  ARRAY may be a vector, a string, a char-table or a
+bool-vector.  IDX starts at 0."
+  (setf (aref array idx) newelt))
+
+(defmacro defalias (to from &optional docstring)
+  "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
+Associates the function with the current load file, if any.
+The optional third argument DOCSTRING specifies the documentation string
+for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
+determined by DEFINITION."
+  ;; FIXME: implement
+  (declare (ignore to from docstring)))
+
+(defun plist-get (plist prop)
+  "Extract a value from a property list.
+PLIST is a property list, which is a list of the form
+\(PROP1 VALUE1 PROP2 VALUE2...).  This function returns the value
+corresponding to the given PROP, or nil if PROP is not
+one of the properties on the list."
+  (getf plist prop))
+
+(defun sequencep (object)
+  "Return t if OBJECT is a sequence (list or array)."
+  (typep object 'sequence))
+
+(defun copy-sequence (seq)
+  "Return a copy of a list, vector, string or char-table.
+The elements of a list or vector are not copied; they are shared
+with the original."
+  (copy-seq seq))
index 9bf7562..ef50a86 100644 (file)
@@ -2,12 +2,6 @@
 
 (in-package "LICE")
 
-(defvar *debug-on-error* t
-  "Non-nil means enter the debugger if an unhandled error is signaled.")
-
-(defvar *debug-on-quit* nil
-  "Non-nil means enter the debugger if quit is signaled (C-g, for example).")
-
 (defvar *debugger-mode*
   (make-instance 'major-mode
                  :name "Debugger"
diff --git a/src/dired.lisp b/src/dired.lisp
new file mode 100644 (file)
index 0000000..8d32268
--- /dev/null
@@ -0,0 +1,28 @@
+;;; Lisp functions for making directory listings.
+
+(in-package "LICE")
+
+(defvar completion-ignored-extensions nil
+  "Completion ignores file names ending in any string in this list.
+It does not ignore them if all possible completions end in one of
+these strings or when displaying a list of completions.
+It ignores directory names if they match any string in this list which
+ends in a slash.")
+
+(defun directory-files ()
+  (error "unimplemented"))
+
+(defun directory-files-and-attributes ()
+  (error "unimplemented"))
+
+(defun file-name-completion ()
+  (error "unimplemented"))
+
+(defun file-name-all-completions ()
+  (error "unimplemented"))
+
+(defun file-attributes ()
+  (error "unimplemented"))
+
+(defun file-attributes-lessp ()
+  (error "unimplemented"))
index 166234b..6969019 100644 (file)
@@ -490,8 +490,10 @@ This function does not move point."
 A multibyte character is handled correctly."
   (char string 0))
 
-(defun char-to-string ()
-  (error "Unimplemented"))
+(defun char-to-string (char)
+"Convert arg CHAR to a string containing that character.
+usage: (char-to-string CHAR)"
+  (string char))
 
 (defun buffer-string ()
   (error "Unimplemented"))
index 9ead271..4314a71 100644 (file)
@@ -1,8 +1,8 @@
 (cl:defpackage "ELISP"
   (:nicknames "EL")
   (:use "CL")
-  (:shadow cl:if)
-  (:export #:if))
+  (:shadow cl:if cl:defun)
+  (:export #:if #:defun))
 
 (in-package "ELISP")
 
           (progn 
             ,@else)))
 
+
+(cl:defun parse-interactive (thing)
+  (error "unimplemented"))
+
+(defmacro defun (name lambda-list &body body)
+  "Parse an elisp style defun and convert it to a cl defun or lice defcommand."
+  (let ((doc (when (stringp (car body))
+               (pop body)))
+        (decls (loop while (eq (caar body) 'declare)
+                  collect (pop body)))
+        (interactive (when (and (listp (car body))
+                                (eq (caar body) 'interactive))
+                       (pop body))))
+    (if interactive
+        `(defcommand ,name (,lambda-list
+                            ,@(parse-interactive (cdr interactive)))
+           ,@(append (list doc) decls body))
+        `(cl:defun ,name ,@(append (list doc) decls body)))))
diff --git a/src/emacs-lisp/easy-mmode.lisp b/src/emacs-lisp/easy-mmode.lisp
new file mode 100644 (file)
index 0000000..4891217
--- /dev/null
@@ -0,0 +1,520 @@
+;;; easy-mmode.el --- easy definition for major and minor modes
+
+;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005,
+;;   2006 Free Software Foundation, Inc.
+
+;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
+;; Maintainer: Stefan Monnier <monnier@gnu.org>
+
+;; Keywords: extensions lisp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; Minor modes are useful and common.  This package makes defining a
+;; minor mode easy, by focusing on the writing of the minor mode
+;; functionalities themselves.  Moreover, this package enforces a
+;; conventional naming of user interface primitives, making things
+;; natural for the minor-mode end-users.
+
+;; For each mode, easy-mmode defines the following:
+;; <mode>      : The minor mode predicate. A buffer-local variable.
+;; <mode>-map  : The keymap possibly associated to <mode>.
+;;       see `define-minor-mode' documentation
+;;
+;; eval
+;;  (pp (macroexpand '(define-minor-mode <your-mode> <doc>)))
+;; to check the result before using it.
+
+;; The order in which minor modes are installed is important.  Keymap
+;; lookup proceeds down minor-mode-map-alist, and the order there
+;; tends to be the reverse of the order in which the modes were
+;; installed.  Perhaps there should be a feature to let you specify
+;; orderings.
+
+;; Additionally to `define-minor-mode', the package provides convenient
+;; ways to define keymaps, and other helper functions for major and minor modes.
+
+;;; Code:
+
+(in-package "LICE")
+
+(defun easy-mmode-pretty-mode-name (mode &optional lighter)
+  "Turn the symbol MODE into a string intended for the user.
+If provided, LIGHTER will be used to help choose capitalization by,
+replacing its case-insensitive matches with the literal string in LIGHTER."
+  (let* ((case-fold-search t)
+        ;; Produce "Foo-Bar minor mode" from foo-bar-minor-mode.
+        (name (concat (replace-regexp-in-string
+                       ;; If the original mode name included "-minor" (some
+                       ;; of them don't, e.g. auto-revert-mode), then
+                       ;; replace it with " minor".
+                       "-Minor" " minor"
+                       ;; "foo-bar-minor" -> "Foo-Bar-Minor"
+                       (capitalize (replace-regexp-in-string
+                                    ;; "foo-bar-minor-mode" -> "foo-bar-minor"
+                                    "-mode\\'" "" (symbol-name mode))))
+                      " mode")))
+    (el:if (not (stringp lighter)) name
+      ;; Strip leading and trailing whitespace from LIGHTER.
+      (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\s-+\\'" ""
+                                             lighter))
+      ;; Replace any (case-insensitive) matches for LIGHTER in NAME
+      ;; with a literal LIGHTER.  E.g., if NAME is "Iimage mode" and
+      ;; LIGHTER is " iImag", then this will produce "iImage mode".
+      ;; (LIGHTER normally comes from the mode-line string passed to
+      ;; define-minor-mode, and normally includes at least one leading
+      ;; space.)
+      (replace-regexp-in-string (regexp-quote lighter) lighter name t t))))
+
+;;;###autoload
+(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
+;;;###autoload
+(defmacro define-minor-mode ((mode doc ;;&optional init-value lighter keymap 
+                              &key init-value lighter ((:global globalp)) extra-args set
+                              initialize group type (require t) keymap)
+                             ;; FIXME: in the original any keys not
+                             ;; above were added to extra-keywords,
+                             ;; but i'm too lazy to do it that way
+                             ;; atm. -sabetts
+                             extra-keywords
+                             &body body)
+  "Define a new minor mode MODE.
+This function defines the associated control variable MODE, keymap MODE-map,
+and toggle command MODE.
+
+DOC is the documentation for the mode toggle command.
+Optional INIT-VALUE is the initial value of the mode's variable.
+Optional LIGHTER is displayed in the modeline when the mode is on.
+Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
+  If it is a list, it is passed to `easy-mmode-define-keymap'
+  in order to build a valid keymap.  It's generally better to use
+  a separate MODE-map variable than to use this argument.
+The above three arguments can be skipped if keyword arguments are
+used (see below).
+
+BODY contains code to execute each time the mode is activated or deactivated.
+  It is executed after toggling the mode,
+  and before running the hook variable `mode-HOOK'.
+  Before the actual body code, you can write keyword arguments (alternating
+  keywords and values).  These following keyword arguments are supported (other
+  keywords will be passed to `defcustom' if the minor mode is global):
+:group GROUP   Custom group name to use in all generated `defcustom' forms.
+               Defaults to MODE without the possible trailing \"-mode\".
+               Don't use this default group name unless you have written a
+               `defgroup' to define that group properly.
+:global GLOBAL If non-nil specifies that the minor mode is not meant to be
+               buffer-local, so don't make the variable MODE buffer-local.
+               By default, the mode is buffer-local.
+:init-value VAL        Same as the INIT-VALUE argument.
+:lighter SPEC  Same as the LIGHTER argument.
+:keymap MAP    Same as the KEYMAP argument.
+:require SYM   Same as in `defcustom'.
+
+For example, you could write
+  (define-minor-mode foo-mode \"If enabled, foo on you!\"
+    :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
+    ...BODY CODE...)"
+  (let* ((last-message (current-message))
+        (mode-name (symbol-name mode))
+        (pretty-name (easy-mmode-pretty-mode-name mode lighter))
+        (hook (intern (concat mode-name "-hook")))
+        (hook-on (intern (concat mode-name "-on-hook")))
+        (hook-off (intern (concat mode-name "-off-hook")))
+        keymap-sym)
+
+;;     ;; Check keys.
+;;     (while (keywordp (setq keyw (car body)))
+;;       (setq body (cdr body))
+;;       (case keyw
+;;     (:init-value (setq init-value (pop body)))
+;;     (:lighter (setq lighter (pop body)))
+;;     (:global (setq globalp (pop body)))
+;;     (:extra-args (setq extra-args (pop body)))
+;;     (:set (setq set (list :set (pop body))))
+;;     (:initialize (setq initialize (list :initialize (pop body))))
+;;     (:group (setq group (nconc group (list :group (pop body)))))
+;;     (:type (setq type (list :type (pop body))))
+;;     (:require (setq require (pop body)))
+;;     (:keymap (setq keymap (pop body)))
+;;     (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
+
+    ;; XXX: :group can occur many times in the original. here only once.
+    (setf keymap-sym (if (and keymap (symbolp keymap)) keymap
+                         (intern (concat mode-name "-MAP")))
+          set `(:set ,(or set 'custom-set-minor-mode))
+          initialize `(:initialize ,(or initialize 'custom-initialize-default))
+          ;; We might as well provide a best-guess default group.
+          group `(:group (or ,group '(intern (replace-regexp-in-string
+                                              "-mode\\'" "" mode-name))))
+          type `(:type ,(or type 'boolean)))
+
+    `(progn
+       ;; Define the variable to enable or disable the mode.
+       ,(if (not globalp)
+           `(progn
+              (define-buffer-local ,mode ,init-value ,(format "Non-nil if %s is enabled.
+Use the command `%s' to change this variable." pretty-name mode))
+              (make-variable-buffer-local ',mode))
+
+         (let ((base-doc-string
+                 (concat "Non-nil if %s is enabled.
+See the command `%s' for a description of this minor-mode."
+                         (if body "
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `%s'."))))
+           `(defcustom ,mode ,init-value
+              ,(format base-doc-string pretty-name mode mode)
+              ,@set
+              ,@initialize
+              ,@group
+              ,@type
+              ,@(unless (eq require t) `(:require ,require))
+               ,@(nreverse extra-keywords))))
+
+       ;; The actual function.
+       (defcommand ,mode ((&optional arg ,@extra-args)
+                          :raw-prefix)
+        ,(or doc
+             (format nil (concat "Toggle ~a on or off.
+Interactively, with no prefix argument, toggle the mode.
+With universal prefix ARG turn mode on.
+With zero or negative ARG turn mode off.
+\\{~s}") pretty-name keymap-sym))
+        ;; Use `toggle' rather than (if ,mode 0 1) so that using
+        ;; repeat-command still does the toggling correctly.
+        ;;(interactive (list (or current-prefix-arg 'toggle)))
+         (unless arg (setf arg 'toggle))
+        (setq ,mode
+              (cond
+               ((eq arg 'toggle) (not ,mode))
+               (arg (> (prefix-numeric-value arg) 0))
+               (t
+                (el:if (null ,mode) t
+                  (message
+                   "Toggling %s off; better pass an explicit argument."
+                   ',mode)
+                  nil))))
+        ,@body
+        ;; The on/off hooks are here for backward compatibility only.
+        (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
+        (if (called-interactively-p)
+            (progn
+              ,(if globalp `(customize-mark-as-set ',mode))
+              ;; Avoid overwriting a message shown by the body,
+               ;; but do overwrite previous messages.
+              (unless  ,(and (current-message)
+                              (not (equal last-message (current-message))))
+                (message ,(format "~a ~~aabled" pretty-name)
+                         (if ,mode "en" "dis")))))
+        (force-mode-line-update)
+        ;; Return the new setting.
+        ,mode)
+
+       ;; XXX: What do we do with this? -sabetts
+;;        ;; Autoloading a define-minor-mode autoloads everything
+;;        ;; up-to-here.
+;;        :autoload-end
+
+       ;; Define the minor-mode keymap.
+       ,(unless (symbolp keymap)       ;nil is also a symbol.
+         `(defvar ,keymap-sym
+            (let ((m ,keymap))
+              (cond ((keymapp m) m)
+                    ((listp m) (easy-mmode-define-keymap m))
+                    (t (error "Invalid keymap %S" ,keymap))))
+            ,(format nil "Keymap for `~s'." mode-name)))
+
+       (add-minor-mode ',mode ',lighter
+                      ,(if keymap keymap-sym
+                         `(if (boundp ',keymap-sym)
+                              (symbol-value ',keymap-sym)))))))
+\f
+;;;
+;;; make global minor mode
+;;;
+
+;;;###autoload
+(defalias 'easy-mmode-define-global-mode 'define-global-minor-mode)
+;;;###autoload
+(defmacro define-global-minor-mode (global-mode mode turn-on &rest keys)
+  "Make GLOBAL-MODE out of the buffer-local minor MODE.
+TURN-ON is a function that will be called with no args in every buffer
+  and that should try to turn MODE on if applicable for that buffer.
+KEYS is a list of CL-style keyword arguments.  As the minor mode
+  defined by this function is always global, any :global keyword is
+  ignored.  Other keywords have the same meaning as in `define-minor-mode',
+  which see.  In particular, :group specifies the custom group.
+  The most useful keywords are those that are passed on to the
+  `defcustom'.  It normally makes no sense to pass the :lighter
+  or :keymap keywords to `define-global-minor-mode', since these
+  are usually passed to the buffer-local version of the minor mode.
+
+If MODE's set-up depends on the major mode in effect when it was
+enabled, then disabling and reenabling MODE should make MODE work
+correctly with the current major mode.  This is important to
+prevent problems with derived modes, that is, major modes that
+call another major mode in their body."
+
+  (let* ((global-mode-name (symbol-name global-mode))
+        (pretty-name (easy-mmode-pretty-mode-name mode))
+        (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
+        (group nil)
+        (extra-keywords nil)
+        (MODE-buffers (intern (concat global-mode-name "-buffers")))
+        (MODE-enable-in-buffers
+         (intern (concat global-mode-name "-enable-in-buffers")))
+        (MODE-check-buffers
+         (intern (concat global-mode-name "-check-buffers")))
+        (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
+        (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
+        keyw)
+
+    ;; Check keys.
+    (while (keywordp (setq keyw (car keys)))
+      (setq keys (cdr keys))
+      (case keyw
+       (:group (setq group (nconc group (list :group (pop keys)))))
+       (:global (setq keys (cdr keys)))
+       (t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+
+    (unless group
+      ;; We might as well provide a best-guess default group.
+      (setq group
+           `(:group ',(intern (replace-regexp-in-string
+                               "-mode\\'" "" (symbol-name mode))))))
+
+    `(progn
+       (defvar ,MODE-major-mode nil)
+       (make-variable-buffer-local ',MODE-major-mode)
+       ;; The actual global minor-mode
+       (define-minor-mode ,global-mode
+        ,(format "Toggle %s in every buffer.
+With prefix ARG, turn %s on if and only if ARG is positive.
+%s is actually not turned on in every buffer but only in those
+in which `%s' turns it on."
+                 pretty-name pretty-global-name pretty-name turn-on)
+        :global t ,@group ,@(nreverse extra-keywords)
+
+        ;; Setup hook to handle future mode changes and new buffers.
+        (el:if ,global-mode
+            (progn
+              (add-hook 'after-change-major-mode-hook
+                        ',MODE-enable-in-buffers)
+              (add-hook 'find-file-hook ',MODE-check-buffers)
+              (add-hook 'change-major-mode-hook ',MODE-cmhh))
+          (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
+          (remove-hook 'find-file-hook ',MODE-check-buffers)
+          (remove-hook 'change-major-mode-hook ',MODE-cmhh))
+
+        ;; Go through existing buffers.
+        (dolist (buf (buffer-list))
+          (with-current-buffer buf
+            (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
+
+       ;; Autoloading define-global-minor-mode autoloads everything
+       ;; up-to-here.
+       :autoload-end
+
+       ;; List of buffers left to process.
+       (defvar ,MODE-buffers nil)
+
+       ;; The function that calls TURN-ON in each buffer.
+       (defun ,MODE-enable-in-buffers ()
+        (dolist (buf ,MODE-buffers)
+          (when (buffer-live-p buf)
+            (with-current-buffer buf
+              (el:if ,mode
+                  (unless (eq ,MODE-major-mode major-mode)
+                    (,mode -1)
+                    (,turn-on)
+                    (setq ,MODE-major-mode major-mode))
+                (,turn-on)
+                (setq ,MODE-major-mode major-mode))))))
+       (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
+
+       (defun ,MODE-check-buffers ()
+        (,MODE-enable-in-buffers)
+        (setq ,MODE-buffers nil)
+        (remove-hook 'post-command-hook ',MODE-check-buffers))
+       (put ',MODE-check-buffers 'definition-name ',global-mode)
+
+       ;; The function that catches kill-all-local-variables.
+       (defun ,MODE-cmhh ()
+        (add-to-list ',MODE-buffers (current-buffer))
+        (add-hook 'post-command-hook ',MODE-check-buffers))
+       (put ',MODE-cmhh 'definition-name ',global-mode))))
+
+;;;
+;;; easy-mmode-defmap
+;;;
+
+(if (fboundp 'set-keymap-parents)
+    (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
+  (defun easy-mmode-set-keymap-parents (m parents)
+    (set-keymap-parent
+     m
+     (cond
+      ((not (consp parents)) parents)
+      ((not (cdr parents)) (car parents))
+      (t (let ((m (copy-keymap (pop parents))))
+          (easy-mmode-set-keymap-parents m parents)
+          m))))))
+
+;;;###autoload
+(defun easy-mmode-define-keymap (bs &optional name m args)
+  "Return a keymap built from bindings BS.
+BS must be a list of (KEY . BINDING) where
+KEY and BINDINGS are suitable for `define-key'.
+Optional NAME is passed to `make-sparse-keymap'.
+Optional map M can be used to modify an existing map.
+ARGS is a list of additional keyword arguments."
+  (let (inherit dense)
+    (while args
+      (let ((key (pop args))
+           (val (pop args)))
+       (case key
+        (:name (setq name val))
+        (:dense (setq dense val))
+        (:inherit (setq inherit val))
+        (:group)
+        (t (message "Unknown argument %s in defmap" key)))))
+    (unless (keymapp m)
+      (setq bs (append m bs))
+      (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
+    (dolist (b bs)
+      (let ((keys (car b))
+           (binding (cdr b)))
+       (dolist (key (if (consp keys) keys (list keys)))
+         (cond
+          ((symbolp key)
+           (substitute-key-definition key binding m *global-map*))
+          ((null binding)
+           (unless (keymapp (lookup-key m key)) (define-key m key binding)))
+          ((let ((o (lookup-key m key)))
+             (or (null o) (numberp o) (eq o 'undefined)))
+           (define-key m key binding))))))
+    (cond
+     ((keymapp inherit) (set-keymap-parent m inherit))
+     ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
+    m))
+
+;;;###autoload
+(defmacro easy-mmode-defmap (m bs doc &rest args)
+  `(defconst ,m
+     (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
+     ,doc))
+
+\f
+;;;
+;;; easy-mmode-defsyntax
+;;;
+
+(defun easy-mmode-define-syntax (css args)
+  (let ((st (make-syntax-table (plist-get args :copy)))
+       (parent (plist-get args :inherit)))
+    (dolist (cs css)
+      (let ((char (car cs))
+           (syntax (cdr cs)))
+       (if (sequencep char)
+           (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
+         (modify-syntax-entry char syntax st))))
+    (if parent (set-char-table-parent
+               st (if (symbolp parent) (symbol-value parent) parent)))
+    st))
+
+;;;###autoload
+(defmacro easy-mmode-defsyntax (st css doc &rest args)
+  "Define variable ST as a syntax-table.
+CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
+  `(progn
+     (autoload 'easy-mmode-define-syntax "easy-mmode")
+     (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
+
+
+\f
+;;;
+;;; easy-mmode-define-navigation
+;;;
+
+(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun)
+  "Define BASE-next and BASE-prev to navigate in the buffer.
+RE determines the places the commands should move point to.
+NAME should describe the entities matched by RE.  It is used to build
+  the docstrings of the two functions.
+BASE-next also tries to make sure that the whole entry is visible by
+  searching for its end (by calling ENDFUN if provided or by looking for
+  the next entry) and recentering if necessary.
+ENDFUN should return the end position (with or without moving point).
+NARROWFUN non-nil means to check for narrowing before moving, and if
+found, do widen first and then call NARROWFUN with no args after moving."
+  (let* ((base-name (symbol-name base))
+        (prev-sym (intern (concat base-name "-prev")))
+        (next-sym (intern (concat base-name "-next")))
+         (check-narrow-maybe
+         (when narrowfun
+           '(setq was-narrowed
+                  (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
+                    (widen)))))
+         (re-narrow-maybe (when narrowfun
+                            `(when was-narrowed (,narrowfun)))))
+    (unless name (setq name base-name))
+    `(progn
+       (add-to-list 'debug-ignored-errors
+                   ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
+       (defun ,next-sym (&optional count)
+        ,(format "Go to the next COUNT'th %s." name)
+        (interactive)
+        (unless count (setq count 1))
+        (el:if (< count 0) (,prev-sym (- count))
+          (if (looking-at ,re) (setq count (1+ count)))
+           (let (was-narrowed)
+             ,check-narrow-maybe
+             (if (not (re-search-forward ,re nil t count))
+                 (if (looking-at ,re)
+                     (goto-char (or ,(if endfun `(,endfun)) (point-max)))
+                   (error "No next %s" ,name))
+               (goto-char (match-beginning 0))
+               (when (and (eq (current-buffer) (window-buffer (selected-window)))
+                          (interactive-p))
+                 (let ((endpt (or (save-excursion
+                                    ,(if endfun `(,endfun)
+                                       `(re-search-forward ,re nil t 2)))
+                                  (point-max))))
+                   (unless (pos-visible-in-window-p endpt nil t)
+                     (recenter '(0))))))
+             ,re-narrow-maybe)))
+       (put ',next-sym 'definition-name ',base)
+       (defun ,prev-sym (&optional count)
+        ,(format "Go to the previous COUNT'th %s" (or name base-name))
+        (interactive)
+        (unless count (setq count 1))
+        (if (< count 0) (,next-sym (- count))
+           (let (was-narrowed)
+             ,check-narrow-maybe
+             (unless (re-search-backward ,re nil t count)
+               (error "No previous %s" ,name))
+             ,re-narrow-maybe)))
+       (put ',prev-sym 'definition-name ',base))))
+
+
+(provide 'easy-mmode)
+
+;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a
+;;; easy-mmode.el ends here 
\ No newline at end of file
diff --git a/src/emacs.lisp b/src/emacs.lisp
new file mode 100644 (file)
index 0000000..e2f9f46
--- /dev/null
@@ -0,0 +1,16 @@
+(in-package "LICE")
+
+;; FIXME: figure out the system type
+(defvar system-type :undefined
+  "Value is symbol indicating type of operating system you are using.
+Special values:
+  `:gnu/linux'   compiled for a GNU/Linux system.
+  `:darwin'      compiled for Darwin (GNU-Darwin, Mac OS X, ...).
+  `:macos'       compiled for Mac OS 9.
+  `:ms-dos'      compiled as an MS-DOS application.
+  `:windows-nt'  compiled as a native W32 application.
+  `:cygwin'      compiled using the Cygwin library.
+  `:vax-vms' or
+  `:axp-vms'     compiled for a (Open)VMS system.
+Anything else indicates some sort of Unix system.  */);
+  Vsystem_type = intern (SYSTEM_TYPE")
diff --git a/src/fns.lisp b/src/fns.lisp
new file mode 100644 (file)
index 0000000..dd64c69
--- /dev/null
@@ -0,0 +1,41 @@
+;;; fns.lisp --- compatibility function from emacs
+
+(in-package "LICE")
+
+(defun concat (&rest strings)
+  "Concatenate all the arguments and make the result a string.
+The result is a string whose elements are the elements of all the arguments.
+Each argument must be a string."
+  (apply 'concatenate 'string strings))
+
+(defun cdr-safe (object)
+  "Return the cdr of OBJECT if it is a cons cell, or else nil."
+  (when (consp object)
+    (cdr object)))
+
+;; XXX: get rid of this function and all callers
+(defun assq (prop list)
+  "Return non-nil if key is `eq' to the car of an element of list.
+The value is actually the first element of list whose car is key.
+Elements of list that are not conses are ignored."
+  (assoc prop (remove-if 'listp list)))
+
+(depricate substring subseq)
+(defun substring (string from &optional (to (length string)))
+  "Return a substring of string, starting at index from and ending before to.
+to may be nil or omitted; then the substring runs to the end of string.
+from and to start at 0.  If either is negative, it counts from the end.
+
+This function allows vectors as well as strings."
+  (when (< from 0)
+    (setf from (max 0 (+ (length string) from))))
+  (when (< to 0)
+    (setf to (max 0 (+ (length string) to))))
+  (subseq string from to))
+
+(depricate memq member)
+(defun memq (elt list)
+  "Return non-nil if ELT is an element of LIST.
+Comparison done with `eq'.  The value is actually the tail of LIST
+whose car is ELT."
+  (member elt list :test 'eq))
index 3710141..d0b94f2 100644 (file)
@@ -44,6 +44,9 @@
 (define-condition lice-condition ()
   () (:documentation "The base condition for all lice related errors."))
 
+(define-condition wrong-type-argument (lice-condition)
+    ((:type :initarg :type :accessor wrong-type-argument-type)))
+
 ;; (defun fmt (fmt &rest args)
 ;;   "A movitz hack function. FORMAT basically doesn't work, so i use this to get around it."
 ;;   (let ((s (make-array 100 :fill-pointer 0 :element-type 'character)))
 
 ;;; Lisp function we like to have
 
-(defun concat (&rest strings)
-  "Concatenate all the arguments and make the result a string.
-The result is a string whose elements are the elements of all the arguments.
-Each argument must be a string."
-  (apply 'concatenate 'string strings))
-
 (defmacro while (test &body body)
   "If TEST yields non-nil, eval BODY... and repeat.
 The order of execution is thus TEST, BODY, TEST, BODY and so on
@@ -72,11 +69,6 @@ until TEST returns nil."
       `(loop while ,test do ,@body)
       `(loop while ,test)))
 
-(defun cdr-safe (object)
-  "Return the cdr of OBJECT if it is a cons cell, or else nil."
-  (when (consp object)
-    (cdr object)))
-
 (defvar *quit-code* 7
   "The terminal char code for the interrupt key.")
 
@@ -93,13 +85,6 @@ before making `inhibit-quit' nil.")
 
 (defvar *quit-flag* nil
   "Set to T when the user hit the quit key")
-  
-;; XXX: get rid of this function and all callers
-(defun assq (prop list)
-  "Return non-nil if key is `eq' to the car of an element of list.
-The value is actually the first element of list whose car is key.
-Elements of list that are not conses are ignored."
-  (assoc prop (remove-if 'listp list)))
 
 (defmacro depricate (symbol refer-to)
   "A macro to mark a symbol as depricated. This is done with
@@ -178,26 +163,6 @@ the hook's buffer-local value rather than its default value."
   (declare (ignore local))
   (setf (symbol-value hook) (remove function (symbol-value hook))))
 
-(depricate substring subseq)
-(defun substring (string from &optional (to (length string)))
-  "Return a substring of string, starting at index from and ending before to.
-to may be nil or omitted; then the substring runs to the end of string.
-from and to start at 0.  If either is negative, it counts from the end.
-
-This function allows vectors as well as strings."
-  (when (< from 0)
-    (setf from (max 0 (+ (length string) from))))
-  (when (< to 0)
-    (setf to (max 0 (+ (length string) to))))
-  (subseq string from to))
-
-(depricate memq member)
-(defun memq (elt list)
-  "Return non-nil if ELT is an element of LIST.
-Comparison done with `eq'.  The value is actually the tail of LIST
-whose car is ELT."
-  (member elt list :test 'eq))
-
 (defun int-to-string (n)
   "Return the decimal representation of number as a string.
 Uses a minus sign if negative.
@@ -253,10 +218,6 @@ not compute it, store the result, and return it."
            (cdr ,match)
            (memoize-store ,mem-var ,thing ,compute)))))
 
-(defun % (number divisor)
-  "same as mod."
-  (mod number divisor))
-
 (defun add-to-list (list-var element &optional append)
   "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
 The test for presence of ELEMENT is done with `equal'.
@@ -285,16 +246,29 @@ other hooks, such as major mode hooks, can do the job."
      (defun ,name ,lambda-list
        ,@body)))
 
-(defun setcar (cell newcar)
-  "Set the car of cell to be newcar.  Returns newcar."
-  (setf (car cell) newcar))
 
-(depricate aset (setf aref))
-(defun aset (array idx newelt)
-  "Store into the element of ARRAY at index IDX the value NEWELT.
-Return NEWELT.  ARRAY may be a vector, a string, a char-table or a
-bool-vector.  IDX starts at 0."
-  (setf (aref array idx) newelt))
+(defvar *debug-on-error* t
+  "Non-nil means enter the debugger if an unhandled error is signaled.")
+
+(defvar *debug-on-quit* nil
+  "Non-nil means enter the debugger if quit is signaled (C-g, for example).")
+
+(defvar debug-ignored-errors nil
+  "*List of errors for which the debugger should not be called.
+Each element may be a condition-name or a regexp that matches error messages.
+If any element applies to a given error, that error skips the debugger
+and just returns to top level.
+This overrides the variable `debug-on-error'.
+It does not apply to errors handled by `condition-case'.")
+
+(defun purecopy (thing)
+  "Make a copy of object OBJ in pure storage.
+Recursively copies contents of vectors and cons cells.
+Does not copy symbols.  Copies strings without text properties."
+  thing)
 
+(defun garbage-collect ()
+  "Reclaim storage for Lisp objects no longer needed."
+  (warn "unimplemented"))
 
 (provide :lice-0.1/global)
index 5e16867..f6ce2e9 100644 (file)
@@ -2,6 +2,10 @@
 
 (in-package "LICE")
 
+(define-buffer-local indent-tabs-mode t
+"*Indentation can insert tabs if this is non-nil.
+Setting this variable automatically makes it local to the current buffer.")
+
 (define-buffer-local *indent-line-function* 'indent-relative
   "Function to indent the current line.
 This function will be called with no arguments.
index ae6d0ee..3ea2e02 100644 (file)
@@ -2,6 +2,10 @@
 
 (in-package "LICE")
 
+(defvar help-event-list nil
+  "List of input events to recognize as meaning Help.
+These work just like the value of `help-char' (see that).")
+
 (define-condition quit (lice-condition)
   () (:documentation "A condition raised when the user aborted the
 operation (by pressing C-g, for instance)."))
@@ -40,39 +44,43 @@ The value is a list of KEYs."
 (defun dispatch-command (name)
   (let* ((cmd (lookup-command name))
         ;; (args (collect-command-args cmd))
-        (*this-command* (command-name cmd))
+        (*this-command* (and cmd (command-name cmd)))
         (*current-prefix-arg* *prefix-arg*))
     (clear-minibuffer)
-    (restart-case
-        (handler-bind
-            ((quit
-              (lambda (c)
-                (if *debug-on-quit*
-                    (signal c)
-                    (invoke-restart 'abort-command))))
-             (lice-condition
-              (lambda (c)
-                (if *debug-on-error*
-                    (signal c)
-                    (invoke-restart 'just-print-error c))))
-             (error 
-              (lambda (c)
-                (if *debug-on-error*
-                    (signal c)
-                    (invoke-restart 'just-print-error c)))))
-          (funcall (command-fn cmd)))
-      (abort-command ()
-        :report "Abort the command."
-        (message "Quit"))
-      (just-print-error (c)
-        :report "Abort and print error."
-        ;; we need a bell
-        (message "~a" c)))
-    (setf *last-command* *this-command*
-         ;; reset command keys, since the command is over.
-         *this-command-keys* nil)
-    ;; handle undo
-    (undo-boundary)))
+    (if cmd
+        (progn
+          (restart-case
+              (handler-bind
+                  ((quit
+                    (lambda (c)
+                      (if *debug-on-quit*
+                          (signal c)
+                          (invoke-restart 'abort-command))))
+                   (lice-condition
+                    (lambda (c)
+                      (if *debug-on-error*
+                          (signal c)
+                          (invoke-restart 'just-print-error c))))
+                   (error 
+                    (lambda (c)
+                      (if *debug-on-error*
+                          (signal c)
+                          (invoke-restart 'just-print-error c)))))
+                (funcall (command-fn cmd)))
+            (abort-command ()
+              :report "Abort the command."
+              (message "Quit"))
+            (just-print-error (c)
+              :report "Abort and print error."
+              ;; we need a bell
+              (message "~a" c)))
+          (setf *last-command* *this-command*)
+          ;; handle undo
+          (undo-boundary))
+        ;; blink
+        (message "Symbol's command is void: ~a" name)
+        ;; reset command keys, since the command is over.
+        *this-command-keys* nil)))
 
 ;;; events
 
@@ -91,19 +99,19 @@ events that invoked the current command."
                               (pop *unread-command-events*)
                               (wait-for-event)))
          (def (if *current-kmap*
-                  (lookup-key-internal *current-kmap* *current-event* t *current-keymap-theme* t)
+                  (lookup-key-internal *current-kmap* *current-event* t *current-keymap-theme* t nil t)
                   ;; no current kmap? 
                   (or 
                    (when *overriding-terminal-local-map* 
-                     (lookup-key-internal *overriding-terminal-local-map* *current-event* t *current-keymap-theme* t))
+                     (lookup-key-internal *overriding-terminal-local-map* *current-event* t *current-keymap-theme* t nil t))
                    (when *overriding-local-map* 
-                     (lookup-key-internal *overriding-local-map* *current-event* t *current-keymap-theme* t))
+                     (lookup-key-internal *overriding-local-map* *current-event* t *current-keymap-theme* t nil t))
                    (when (current-local-map)
-                     (lookup-key-internal (current-local-map) *current-event* t *current-keymap-theme* t))
+                     (lookup-key-internal (current-local-map) *current-event* t *current-keymap-theme* t nil t))
                    ;;(lookup-key-internal (major-mode-map (major-mode)) *current-event* t *current-keymap-theme* t)
                    ;; TODO: minor mode maps
                    ;; check the global map
-                   (lookup-key-internal *global-map* *current-event* t *current-keymap-theme* t)))))
+                   (lookup-key-internal *global-map* *current-event* t *current-keymap-theme* t nil t)))))
     (dformat +debug-v+ "~a ~s ~a~%"
             def #|(key-hashid *current-event*)|# *current-event* (key-char *current-event*))
     (if def
@@ -177,4 +185,12 @@ events that invoked the current command."
   (catch :unbound-key
     (next-event)))
 
+;;; Key bindings
+
+(define-key *global-map* "C-z" 'suspend-emacs)
+(define-key *ctl-x-map* "C-z" 'suspend-emacs)
+(define-key *global-map* "M-C-c" 'exit-recursive-edit)
+(define-key *global-map* "C-]" 'abort-recursive-edit)
+(define-key *global-map* "M-x" 'execute-extended-command)
+
 (provide :lice-0.1/input)
index 3040ee0..67005e1 100644 (file)
@@ -2,6 +2,9 @@
 
 (in-package "LICE")
 
+;; for mouse click events
+(defstruct click where button)
+
 (defstruct key char control meta alt shift hyper super)
 ;; (defclass key ()
 ;;   ((char :type character :initarg :char :reader key-char)
@@ -49,11 +52,27 @@ for passing as the last argument to (apply #'make-key ...)"
                                 (#\S (list :shift t))
                                 (t (signal 'kbd-parse))))))
 
+(defvar *keysyms* nil
+  "An alist of keysyms that map a string to either a character or a symbol.")
+
+(defmacro define-keysym (string thing)
+  `(pushnew (cons ,string ,thing) *keysyms* :test 'equal))
+
+(define-keysym "RET" #\Newline)
+(define-keysym "TAB" #\Tab)
+(define-keysym "SPC" #\Space)
+
+(define-keysym "up" :up)
+(define-keysym "down" :down)
+(define-keysym "left" :left)
+(define-keysym "right" :right)
+(define-keysym "prior" :prior)
+
 (defun parse-char-name (string)
   "Return the character whose name is STRING."
-  (or (cond 
-        ((string= string "RET") #\Newline)
-        ((string= string "TAB") #\Tab))
+  (or (let ((sym (find string *keysyms* :test 'string= :key 'car)))
+        (when sym
+          (cdr sym)))
       (name-char string)
       (and (= (length string) 1)
           (char string 0))))
@@ -129,23 +148,57 @@ in case you use it as a menu with `x-popup-menu'."
   (or (get-keymap-theme keymap theme)
       (setf (gethash theme (keymap-themes keymap)) (make-hash-table :size 200 :test 'equalp))))
 
-(defun define-key (keymap key def &optional (theme :lice))
+(defgeneric define-key (keymap key def &optional theme)
+  (:documentation "In keymap, define key sequence key as def.
+keymap is a keymap."))
+
+(defmethod define-key (keymap (key vector) def &optional (theme :lice))
+  "for some weirdness in bindings.lisp"
+  (warn "unimplemented"))
+
+(defmethod define-key (keymap (key click) def &optional (theme :lice))
+  "Mouse click events"
+  (warn "unimplemented"))
+
+(defmethod define-key (keymap (key string) (def string) &optional (theme :lice))
+  "alias a key to another key."
+  (warn "unimplemented"))
+
+(defmethod define-key (keymap (key symbol) def &optional (theme :lice))
+  "Special events are represented as symbols."
+  (warn "unimplemented"))
+
+(defmethod define-key (keymap (key string) def &optional (theme :lice))
+  (define-key keymap (parse-key-seq key) def theme))
+
+(defmethod define-key (keymap (key list) def &optional (theme :lice))
+  (let ((map (lookup-key-internal keymap key nil theme nil t nil)))
+    ;; FIXME: do this error properly
+    (unless map (error "Key sequence %s starts with non-prefix key %s"))
+    (define-key map (car (last key)) def theme)))
+
+(defmethod define-key (keymap (key key) def &optional (theme :lice))
   (let ((map (get-keymap-theme-create keymap theme)))
     (setf (gethash #|(key-hashid key)|# key map) def)))
 
-(defun lookup-key-internal (keymap key accept-default theme norecurse)
+(defun lookup-key-internal (keymap key accept-default theme norecurse return-kmap check-parents)
+  "RETURN-KMAP means return the key's keymap."
   (let* ((map (get-keymap-theme keymap theme))
          ;; some maps may not have a hash table for the theme.
-         (cmd (and map (gethash #|(key-hashid key)|# key map))))
+         (cmd (and map (gethash (if (consp key) (car key) key)
+                                map))))
     (or
      ;; if the binding is another keymap, then lookup the rest of the key sequence
      (cond
+       ((and return-kmap
+             (= (length key) 1)
+                  keymap))
        ((and (keymapp cmd) (not norecurse))
-        (lookup-key-internal cmd (cdr key) accept-default theme norecurse))
+        (lookup-key-internal cmd (cdr key) accept-default theme norecurse return-kmap check-parents))
        (t cmd))
      ;; check parent for binding
-     (when (keymap-parent keymap)
-       (lookup-key-internal (keymap-parent keymap) key nil theme norecurse))
+     (when (and check-parents (keymap-parent keymap))
+       (lookup-key-internal (keymap-parent keymap) key nil theme norecurse return-kmap check-parents))
      (when accept-default
        (and map (gethash t map))))))
 
@@ -159,7 +212,7 @@ usable as a general function for probing keymaps.  However, if the
 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
 recognize the default bindings, just as `read-key-sequence' does."
   (check-type keymap keymap)
-  (lookup-key-internal keymap key accept-default theme nil))
+  (lookup-key-internal keymap key accept-default theme nil nil t))
 
 (depricate set-keymap-parent (setf keymap-parent))
 (defun set-keymap-parent (keymap parent)
@@ -187,12 +240,19 @@ grandparent's bindings are also included and so on."
     (when (keymap-parent keymap)
       (map-keymap function (keymap-parent keymap) theme))))
 
+(defvar *esc-map* (make-sparse-keymap)
+  "Default keymap for ESC (meta) commands.
+The normal global definition of the character ESC indirects to this keymap.")
+
 (defvar *global-map* (make-sparse-keymap)
   "The top level global keymap.")
 
 (defvar *ctl-x-4-map* (make-sparse-keymap)
   "The C-x 4 keymap.")
 
+(defvar *ctl-x-5-map* (make-sparse-keymap)
+  "The C-x 4 keymap.")
+
 (defvar *ctl-x-map* (make-sparse-keymap)
   "The C-x keymap.")
 
@@ -202,119 +262,45 @@ grandparent's bindings are also included and so on."
 (defvar *ctl-h-map* (make-sparse-keymap)
   "The C-h keymap.")
 
+(defvar *function-key-map* (make-sparse-keymap)
+  "Keymap that translates key sequences to key sequences during input.
+This is used mainly for mapping ASCII function key sequences into
+real Emacs function key events (symbols).
+
+The `read-key-sequence' function replaces any subsequence bound by
+`function-key-map' with its binding.  More precisely, when the active
+keymaps have no binding for the current key sequence but
+`function-key-map' binds a suffix of the sequence to a vector or string,
+`read-key-sequence' replaces the matching suffix with its binding, and
+continues with the new sequence.
+
+If the binding is a function, it is called with one argument (the prompt)
+and its return value (a key sequence) is used.
+
+The events that come from bindings in `function-key-map' are not
+themselves looked up in `function-key-map'.
+
+For example, suppose `function-key-map' binds `ESC O P' to [f1].
+Typing `ESC O P' to `read-key-sequence' would return [f1].  Typing
+`C-x ESC O P' would return [?\\C-x f1].  If [f1] were a prefix
+key, typing `ESC O P x' would return [f1 x].")
+
 (defvar *current-global-map* *global-map*)
 
 (defvar *current-kmap* nil
   "The key map that the next key event will use to find a
 corresponding command.")
 
-(defun make-ctrl-h-map ()
-  (let ((kmap (make-sparse-keymap)))
-    (define-key kmap (make-key :char #\f) 'describe-symbol)
-    kmap))
-
-(defun make-ctrl-x-4-map ()
-  (let ((kmap (make-sparse-keymap)))
-    (define-key kmap (make-key :char #\b) 'switch-to-buffer-other-window)
-    kmap))
-
-(defun make-ctrl-x-map (ctl-x-4-map)
-  (let ((kmap (make-sparse-keymap)))
-    (define-key kmap (make-key :char #\e :control t) 'eval-last-sexp)
-    (define-key kmap (make-key :char #\b) 'switch-to-buffer)
-    (define-key kmap (make-key :char #\c :control t) 'save-buffers-kill-emacs)
-    (define-key kmap (make-key :char #\f :control t) 'find-file)
-    (define-key kmap (make-key :char #\s :control t) 'save-buffer)
-    (define-key kmap (make-key :char #\k) 'kill-buffer)
-    (define-key kmap (make-key :char #\o) 'other-window)
-    (define-key kmap (make-key :char #\1) 'delete-other-windows)
-    (define-key kmap (make-key :char #\2) 'split-window-vertically)
-    (define-key kmap (make-key :char #\3) 'split-window-horizontally)
-    (define-key kmap (make-key :char #\x :control t) 'exchange-point-and-mark)
-    (define-key kmap (make-key :char #\t :control t) 'transpose-lines)
-    (define-key kmap (make-key :char #\4) ctl-x-4-map)
-    kmap))
-
-(defun make-ctrl-c-map ()
-  (let ((kmap (make-sparse-keymap)))
-    kmap))
-
-(defun make-global-map (ctl-x-prefix ctl-c-prefix ctl-h-prefix)
-  "Generate self-insert commands for all printable characters. And
-more."
-  (let ((kmap (make-sparse-keymap)))
-    (loop for i in '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
-                    #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j
-                    #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t
-                    #\u #\v #\w #\x #\y #\z 
-                    #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J
-                    #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T
-                    #\U #\V #\W #\X #\Y #\Z
-                    #\Space #\! #\" #\# #\$ #\% #\& #\' #\( 
-                    #\) #\* #\+ #\, #\- #\. #\/ #\: #\; #\< 
-                    #\= #\> #\? #\@ #\[ #\\ #\] #\^ #\_ #\` 
-                    #\| #\} #\~ #\{)
-         do (define-key kmap (make-key :char i) 'self-insert-command))
-    (define-key kmap (make-key :char #\Return) 'newline)
-    (define-key kmap (make-key :char #\Newline) 'newline)
-    (define-key kmap (make-key :char #\o :control t) 'open-line)
-    (define-key kmap (make-key :char #\j :control t) 'newline)
-    (define-key kmap (make-key :char #\m :control t) 'newline)
-    (define-key kmap (make-key :char #\f :control t) 'forward-char)
-    (define-key kmap (make-key :char #\f :meta t) 'forward-word)
-    (define-key kmap (make-key :char #\f :control t :meta t) 'forward-sexp)
-    (define-key kmap (make-key :char #\b :control t :meta t) 'backward-sexp)
-    (define-key kmap (make-key :char #\n :control t) 'next-line)
-    (define-key kmap (make-key :char #\p :control t) 'previous-line)
-    (define-key kmap (make-key :char #\b :control t) 'backward-char)
-    (define-key kmap (make-key :char #\b :meta t) 'backward-word)
-    (define-key kmap (make-key :char #\d :control t) 'delete-char)
-    (define-key kmap (make-key :char #\d :meta t) 'kill-word)
-    (define-key kmap (make-key :char #\Rubout :meta t) 'backward-kill-word)
-    (define-key kmap (make-key :char #\Rubout) 'delete-backward-char)
-    (define-key kmap (make-key :char #\Delete) 'delete-backward-char)
-    (define-key kmap (make-key :char #\t :meta t) 'transpose-words)
-    (define-key kmap (make-key :char #\t :control t) 'transpose-chars)
-    ;;(define-key kmap (make-key :char #\h :control t) 'delete-backward-char)
-    (define-key kmap (make-key :char #\u :control t) 'universal-argument)
-    (define-key kmap (make-key :char #\a :control t) 'beginning-of-line)
-    (define-key kmap (make-key :char #\e :control t) 'end-of-line)
-    (define-key kmap (make-key :char #\g :control t) 'keyboard-quit)
-    (define-key kmap (make-key :char #\v :control t) 'scroll-up)
-    (define-key kmap (make-key :char #\v :meta t) 'scroll-down)
-    (define-key kmap (make-key :char #\k :control t) 'kill-line)
-    (define-key kmap (make-key :char #\w :control t) 'kill-region)
-    (define-key kmap (make-key :char #\y :control t) 'yank)
-    (define-key kmap (make-key :char #\y :meta t) 'yank-pop)
-    (define-key kmap (make-key :char #\w :meta t) 'kill-ring-save)
-    (define-key kmap (make-key :char #\> :meta t) 'end-of-buffer)
-    (define-key kmap (make-key :char #\< :meta t) 'beginning-of-buffer)
-    (define-key kmap (make-key :char #\x :meta t) 'execute-extended-command)
-    (define-key kmap (make-key :char #\: :meta t) 'eval-expression)
-    (define-key kmap (make-key :char #\Space :control t) 'set-mark-command)
-    (define-key kmap (make-key :char #\` :control t) 'set-mark-command)
-    (define-key kmap (make-key :char #\! :meta t) 'shell-command)
-    (define-key kmap (make-key :char #\Space :meta t) 'just-one-space)
-    (define-key kmap (make-key :char #\\ :control t :meta t) 'indent-region)
-    (define-key kmap (make-key :char #\a :control t :meta t) 'beginning-of-defun)
-    (define-key kmap (make-key :char #\e :control t :meta t) 'end-of-defun)
-    (define-key kmap (make-key :char #\_ :control t) 'undo)
-    (define-key kmap (make-key :char #\/ :control t) 'undo)
-    (define-key kmap (make-key :char #\} :meta t) 'forward-paragraph)
-    (define-key kmap (make-key :char #\{ :meta t) 'backward-paragraph)
-    (define-key kmap (make-key :char #\x :control t) ctl-x-prefix)
-    (define-key kmap (make-key :char #\c :control t) ctl-c-prefix)
-    (define-key kmap (make-key :char #\h :control t) ctl-h-prefix)
-    kmap))
-
-(defun make-global-keymaps ()
-  "Create the default global keymaps and store them in *global-kmap
-*ctl-x-map*, ..."
-  (setf *ctl-x-4-map* (make-ctrl-x-4-map)
-       *ctl-x-map* (make-ctrl-x-map *ctl-x-4-map*)
-       *ctl-c-map* (make-ctrl-c-map)
-       *ctl-h-map* (make-ctrl-h-map)
-       *global-map* (make-global-map *ctl-x-map* *ctl-c-map* *ctl-h-map*)))
+;; initialize a skeleton structure for the keymaps
+(define-key *global-map* "ESC" *esc-map*)
+(define-key *esc-map* "ESC" (make-sparse-keymap))
+(define-key *global-map* "C-x" *ctl-x-map*)
+(define-key *ctl-x-map* "n" (make-sparse-keymap))
+(define-key *global-map* "C-c" *ctl-c-map*)
+(define-key *global-map* "C-h" *ctl-h-map*)
+(define-key *ctl-x-map* "r" (make-sparse-keymap))
+(define-key *ctl-x-map* "a" (make-sparse-keymap))
+(define-key *ctl-x-map* "a i" (make-sparse-keymap))
 
 (defun copy-keymap (keymap)
   (declare (ignore keymap))
@@ -390,3 +376,129 @@ not be in the future."
 (defun apropos-internal ()
   (error "unimplemented"))
 
+;; This is a struct to make it easier to add new elements to, should
+;; we want to. Also, it makes code easier to read, I think.
+(defstruct minor-mode-map
+  variable keymap)
+
+(defvar *minor-mode-map-list* nil
+  "Alist of keymaps to use for minor modes.
+Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
+key sequences and look up bindings iff VARIABLE's value is non-nil.
+If two active keymaps bind the same key, the keymap appearing earlier
+in the list takes precedence.")
+
+(define-buffer-local *minor-mode-overriding-map-list* nil
+  "Alist of keymaps to use for minor modes, in current major mode.
+This variable is an alist just like `*minor-mode-map-list*', and it is
+used the same way (and before `*minor-mode-map-list*'); however,
+it is provided for major modes to bind locally.")
+
+
+;; (defun make-ctrl-h-map ()
+;;   (let ((kmap (make-sparse-keymap)))
+;;     (define-key kmap (make-key :char #\f) 'describe-symbol)
+;;     kmap))
+
+;; (defun make-ctrl-x-4-map ()
+;;   (let ((kmap (make-sparse-keymap)))
+;;     (define-key kmap (make-key :char #\b) 'switch-to-buffer-other-window)
+;;     kmap))
+
+;; (defun make-ctrl-x-map (ctl-x-4-map)
+;;   (let ((kmap (make-sparse-keymap)))
+;;     (define-key kmap (make-key :char #\e :control t) 'eval-last-sexp)
+;;     (define-key kmap (make-key :char #\b) 'switch-to-buffer)
+;;     (define-key kmap (make-key :char #\c :control t) 'save-buffers-kill-emacs)
+;;     (define-key kmap (make-key :char #\f :control t) 'find-file)
+;;     (define-key kmap (make-key :char #\s :control t) 'save-buffer)
+;;     (define-key kmap (make-key :char #\k) 'kill-buffer)
+;;     (define-key kmap (make-key :char #\o) 'other-window)
+;;     (define-key kmap (make-key :char #\1) 'delete-other-windows)
+;;     (define-key kmap (make-key :char #\2) 'split-window-vertically)
+;;     (define-key kmap (make-key :char #\3) 'split-window-horizontally)
+;;     (define-key kmap (make-key :char #\x :control t) 'exchange-point-and-mark)
+;;     (define-key kmap (make-key :char #\t :control t) 'transpose-lines)
+;;     (define-key kmap (make-key :char #\4) ctl-x-4-map)
+;;     kmap))
+
+;; (defun make-ctrl-c-map ()
+;;   (let ((kmap (make-sparse-keymap)))
+;;     kmap))
+
+;; (defun make-global-map (ctl-x-prefix ctl-c-prefix ctl-h-prefix)
+;;   "Generate self-insert commands for all printable characters. And
+;; more."
+;;   (let ((kmap (make-sparse-keymap)))
+;;     (loop for i in '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+;;                  #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j
+;;                  #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t
+;;                  #\u #\v #\w #\x #\y #\z 
+;;                  #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J
+;;                  #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T
+;;                  #\U #\V #\W #\X #\Y #\Z
+;;                  #\Space #\! #\" #\# #\$ #\% #\& #\' #\( 
+;;                  #\) #\* #\+ #\, #\- #\. #\/ #\: #\; #\< 
+;;                  #\= #\> #\? #\@ #\[ #\\ #\] #\^ #\_ #\` 
+;;                  #\| #\} #\~ #\{)
+;;       do (define-key kmap (make-key :char i) 'self-insert-command))
+;;     (define-key kmap (make-key :char #\Return) 'newline)
+;;     (define-key kmap (make-key :char #\Newline) 'newline)
+;;     (define-key kmap (make-key :char #\o :control t) 'open-line)
+;;     (define-key kmap (make-key :char #\j :control t) 'newline)
+;;     (define-key kmap (make-key :char #\m :control t) 'newline)
+;;     (define-key kmap (make-key :char #\f :control t) 'forward-char)
+;;     (define-key kmap (make-key :char #\f :meta t) 'forward-word)
+;;     (define-key kmap (make-key :char #\f :control t :meta t) 'forward-sexp)
+;;     (define-key kmap (make-key :char #\b :control t :meta t) 'backward-sexp)
+;;     (define-key kmap (make-key :char #\n :control t) 'next-line)
+;;     (define-key kmap (make-key :char #\p :control t) 'previous-line)
+;;     (define-key kmap (make-key :char #\b :control t) 'backward-char)
+;;     (define-key kmap (make-key :char #\b :meta t) 'backward-word)
+;;     (define-key kmap (make-key :char #\d :control t) 'delete-char)
+;;     (define-key kmap (make-key :char #\d :meta t) 'kill-word)
+;;     (define-key kmap (make-key :char #\Rubout :meta t) 'backward-kill-word)
+;;     (define-key kmap (make-key :char #\Rubout) 'delete-backward-char)
+;;     (define-key kmap (make-key :char #\Delete) 'delete-backward-char)
+;;     (define-key kmap (make-key :char #\t :meta t) 'transpose-words)
+;;     (define-key kmap (make-key :char #\t :control t) 'transpose-chars)
+;;     ;;(define-key kmap (make-key :char #\h :control t) 'delete-backward-char)
+;;     (define-key kmap (make-key :char #\u :control t) 'universal-argument)
+;;     (define-key kmap (make-key :char #\a :control t) 'beginning-of-line)
+;;     (define-key kmap (make-key :char #\e :control t) 'end-of-line)
+;;     (define-key kmap (make-key :char #\g :control t) 'keyboard-quit)
+;;     (define-key kmap (make-key :char #\v :control t) 'scroll-up)
+;;     (define-key kmap (make-key :char #\v :meta t) 'scroll-down)
+;;     (define-key kmap (make-key :char #\k :control t) 'kill-line)
+;;     (define-key kmap (make-key :char #\w :control t) 'kill-region)
+;;     (define-key kmap (make-key :char #\y :control t) 'yank)
+;;     (define-key kmap (make-key :char #\y :meta t) 'yank-pop)
+;;     (define-key kmap (make-key :char #\w :meta t) 'kill-ring-save)
+;;     (define-key kmap (make-key :char #\> :meta t) 'end-of-buffer)
+;;     (define-key kmap (make-key :char #\< :meta t) 'beginning-of-buffer)
+;;     (define-key kmap (make-key :char #\x :meta t) 'execute-extended-command)
+;;     (define-key kmap (make-key :char #\: :meta t) 'eval-expression)
+;;     (define-key kmap (make-key :char #\Space :control t) 'set-mark-command)
+;;     (define-key kmap (make-key :char #\` :control t) 'set-mark-command)
+;;     (define-key kmap (make-key :char #\! :meta t) 'shell-command)
+;;     (define-key kmap (make-key :char #\Space :meta t) 'just-one-space)
+;;     (define-key kmap (make-key :char #\\ :control t :meta t) 'indent-region)
+;;     (define-key kmap (make-key :char #\a :control t :meta t) 'beginning-of-defun)
+;;     (define-key kmap (make-key :char #\e :control t :meta t) 'end-of-defun)
+;;     (define-key kmap (make-key :char #\_ :control t) 'undo)
+;;     (define-key kmap (make-key :char #\/ :control t) 'undo)
+;;     (define-key kmap (make-key :char #\} :meta t) 'forward-paragraph)
+;;     (define-key kmap (make-key :char #\{ :meta t) 'backward-paragraph)
+;;     (define-key kmap (make-key :char #\x :control t) ctl-x-prefix)
+;;     (define-key kmap (make-key :char #\c :control t) ctl-c-prefix)
+;;     (define-key kmap (make-key :char #\h :control t) ctl-h-prefix)
+;;     kmap))
+
+;; (defun make-global-keymaps ()
+;;   "Create the default global keymaps and store them in *global-kmap
+;; *ctl-x-map*, ..."
+;;   (setf *ctl-x-4-map* (make-ctrl-x-4-map)
+;;     *ctl-x-map* (make-ctrl-x-map *ctl-x-4-map*)
+;;     *ctl-c-map* (make-ctrl-c-map)
+;;     *ctl-h-map* (make-ctrl-h-map)
+;;     *global-map* (make-global-map *ctl-x-map* *ctl-c-map* *ctl-h-map*)))
dissimilarity index 77%
index 4399cb9..b5cf48b 100644 (file)
@@ -1,63 +1,77 @@
-;; -*- lisp -*-
-
-(defpackage :lice-system (:use :cl :asdf))
-(in-package :lice-system)
-
-(load "package.lisp")
-
-(defsystem :lice
-    :depends-on (#-clisp cl-ncurses cl-ppcre #+sbcl sb-posix)
-    :components ((:file "wrappers")
-                 (:file "elisp")
-                 (:file "global")
-                 (:file "custom")
-                 (:file "commands")
-                 (:file "data-types")
-                 (:file "charset")
-                 (:file "keymap" :depends-on ("global"))
-                 (:file "casefiddle")
-                 (:file "subprocesses" :depends-on ("wrappers" "commands"))
-                 (:file "buffer-local" :depends-on ("data-types"))
-                 (:file "buffer" :depends-on ("data-types" "buffer-local" "commands" "wrappers" "global"))
-                 (:file "intervals" :depends-on ("data-types"))
-                 (:file "textprop" :depends-on ("intervals" "global"))
-                 (:file "search" :depends-on ("buffer"))
-                 (:file "frame" :depends-on ("data-types"))
-                 (:file "window" :depends-on ("buffer" "search" "commands" "frame" "data-types"))
-                 (:file "render" :depends-on ("frame" "window"))
-                 (:file "wm" :depends-on ("data-types" "window" "frame"))
-
-                 ;; from this point on there are warnings because of two-way dependencies
-                 (:file "insdel" :depends-on ("intervals" #|"undo"|# "buffer"))
-                 (:file "cmds" :depends-on ("keymap" "insdel"))
-                 (:file "editfns" :depends-on ("buffer" "insdel" "textprop" "cmds"))
-                 (:file "undo" :depends-on ("commands" "window"))
-                 (:file "syntax" :depends-on ("buffer"))
-                 (:file "major-mode" :depends-on ("keymap" "syntax"))
-                 (:file "keyboard" :depends-on ("commands" "keymap" "subprocesses" "render"))
-                 (:file "debugger" :depends-on ("commands" "major-mode"))
-                 (:file "recursive-edit" :depends-on ("keyboard" "render" "debugger"))
-                 (:file "minibuffer" :depends-on ("buffer" "window" "recursive-edit" "wm"))
-                 (:file "files" :depends-on ("buffer" "buffer-local" "commands" "custom"))
-                 (:file "help" :depends-on ("buffer" "commands"))
-                 (:file "debug" :depends-on ("buffer" "commands"))
-                 #+sbcl (:file "tty-render" :depends-on ("buffer" "window" "frame" "render"))
-                 #+clisp (:file "clisp-render" :depends-on ("buffer" "window" "frame" "render"))
-                 (:file "main" :depends-on ("buffer" "major-mode" "elisp" #+sbcl "tty-render" #+clisp "clisp-render"))
-                 (:file "indent" :depends-on (#|"subr"|#))
-
-                 (:module lisp
-                          :components ((:file "subr")
-                                       (:file "simple" :depends-on ("subr" #|"textmodes/fill"|#))
-                                       (:file "lisp-mode" :depends-on (#|"indent"|# "simple"))
-                                       (:file "lisp-indent" :depends-on ("lisp-mode" #|"indent"|# "simple"))
-                                       (:file "paragraphs" :depends-on ("simple"))))
-
-                 (:module textmodes
-                          :components (;; (:file "fill" :depends-on ()) ; this one is too advanced for now
-                                       (:file "text-mode" :depends-on ())))
-
-                 (:module play
-                          :components ((:file "dissociate" :depends-on nil)
-                                       (:file "hanoi")
-                                       (:file "doctor" :depends-on (#|"simple" "paragraphs" text-mode"|#))))))
+;; -*- lisp -*-
+
+(defpackage :lice-system (:use :cl :asdf))
+(in-package :lice-system)
+
+(defsystem :lice
+    :depends-on (#-clisp cl-ncurses cl-ppcre #+sbcl sb-posix)
+    :serial t
+    :components ((:file "package")
+                 (:file "wrappers")
+                 (:file "emacs")
+                 (:file "callproc")
+                 (:file "elisp")
+                 (:file "global")
+                 (:file "fns")
+                 (:file "data")
+                 (:file "custom")
+                 (:file "commands")
+                 (:file "dired")
+                 (:file "data-types")
+                 (:file "charset")
+                 (:file "subprocesses")
+                 (:file "buffer-local")
+                 (:file "keymap")
+                 (:file "casefiddle")
+                 (:file "buffer")
+                 (:file "intervals")
+                 (:file "textprop")
+                 (:file "search")
+                 (:file "frame")
+                 (:file "window")
+                 (:file "render")
+                 (:file "wm")
+
+                 ;; from this point on there are warnings because of two-way dependencies
+                 (:file "insdel")
+                 (:file "cmds")
+                 (:file "editfns")
+                 (:file "undo")
+                 (:file "syntax")
+                 (:file "major-mode")
+                 (:file "keyboard")
+                 (:file "debugger")
+                 (:file "recursive-edit")
+                 (:file "minibuffer")
+                 (:file "files")
+                 (:file "help")
+                 (:file "debug")
+                 #+sbcl (:file "tty-render")
+                 #+clisp (:file "clisp-render")
+                 (:file "indent")
+
+                 (:module lisp
+                          :serial t
+                          :components ((:file "subr")
+                                       (:file "simple")
+                                       (:file "lisp-mode")
+                                       (:file "lisp-indent")
+                                       (:file "paragraphs")
+                                       (:file "bindings")))
+
+                 (:module emacs-lisp
+                          :serial t
+                          :components ((:file "easy-mmode")))
+
+                 (:module textmodes
+                          :serial t
+                          :components (;; (:file "fill" :depends-on ()) ; this one is too advanced for now
+                                       (:file "text-mode")))
+
+                 (:module play
+                          :serial t
+                          :components ((:file "dissociate")
+                                       (:file "hanoi")
+                                       (:file "doctor")))
+
+                 (:file "main")))
diff --git a/src/lisp/bindings.lisp b/src/lisp/bindings.lisp
new file mode 100644 (file)
index 0000000..8f3df89
--- /dev/null
@@ -0,0 +1,1082 @@
+;;; bindings.el --- define standard key bindings and some variables
+
+;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1999,
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+;;; Special formatting conventions are used in this file!
+;;;
+;;; A backslash-newline is used at the beginning of a documentation string
+;;; when that string should be stored in the file etc/DOCnnn, not in core.
+;;;
+;;; Such strings read into Lisp as numbers (during the pure-loading phase).
+;;;
+;;; But you must obey certain rules to make sure the string is understood
+;;; and goes into etc/DOCnnn properly.
+;;;
+;;; The doc string must appear in the standard place in a call to
+;;; defun, autoload, defvar or defconst.  No Lisp macros are recognized.
+;;; The open-paren starting the definition must appear in column 0.
+;;;
+;;; In defvar and defconst, there is an additional rule:
+;;; The double-quote that starts the string must be on the same
+;;; line as the defvar or defconst.
+;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+;;; Code:
+
+(in-package "LICE")
+
+(defun make-mode-line-mouse-map (mouse function) "\
+Return a keymap with single entry for mouse key MOUSE on the mode line.
+MOUSE is defined to run function FUNCTION with no args in the buffer
+corresponding to the mode line clicked."
+  (let ((map (make-sparse-keymap)))
+    (define-key map (vector 'mode-line mouse) function)
+    map))
+
+
+(defcommand mode-line-toggle-read-only ((event)
+                                        :event)
+  "Like `toggle-read-only', for the mode-line."
+  ;;(interactive "e")
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (toggle-read-only)
+    (force-mode-line-update)))
+
+
+(defcommand mode-line-toggle-modified ((event)
+                                       :event)
+  "Toggle the buffer-modified flag from the mode-line."
+  ;;(interactive "e")
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (set-buffer-modified-p (not (buffer-modified-p)))
+    (force-mode-line-update)))
+
+
+(defcommand mode-line-widen ((event)
+                             :event)
+  "Widen a buffer from the mode-line."
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (widen)
+    (force-mode-line-update)))
+
+
+(defcommand mode-line-abbrev-mode ((event)
+                                   :event)
+  "Turn off `abbrev-mode' from the mode-line."
+  ;;(interactive "e")
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (abbrev-mode)
+    (force-mode-line-update)))
+
+
+(defcommand mode-line-auto-fill-mode ((event)
+                                      :event)
+  "Turn off `auto-fill-mode' from the mode-line."
+  ;;(interactive "e")
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (auto-fill-mode)
+    (force-mode-line-update)))
+
+;; FIXME: when we figure out charsets and stuff, maybe uncomment this -sabetts
+;; FIXME: interactive lambdas are impossible in LICE
+;; (defvar mode-line-input-method-map
+;;   (let ((map (make-sparse-keymap)))
+;;     (define-key map (make-click :where :mode-line :button :mouse-2)
+;;       (lambda (e)
+;;     (interactive "e")
+;;     (save-selected-window
+;;       (select-window
+;;        (posn-window (event-start e)))
+;;       (toggle-input-method)
+;;       (force-mode-line-update))))
+;;     (define-key map (make-click :where :mode-line :button :mouse-3)
+;;       (lambda (e)
+;;     (interactive "e")
+;;     (save-selected-window
+;;       (select-window
+;;        (posn-window (event-start e)))
+;;       (describe-current-input-method))))
+;;     (purecopy map)))
+;;
+;; ;; FIXME: interactive lambdas are impossible in LICE
+;; (defvar mode-line-coding-system-map
+;;   (let ((map (make-sparse-keymap)))
+;;     (define-key map (make-click :where :mode-line :button :mouse-1)
+;;       (lambda (e)
+;;     (interactive "e")
+;;     (save-selected-window
+;;       (select-window (posn-window (event-start e)))
+;;       (when (and enable-multibyte-characters
+;;                  buffer-file-coding-system)
+;;         (describe-coding-system buffer-file-coding-system)))))
+;;     (purecopy map))
+;;   "Local keymap for the coding-system part of the mode line.")
+;;
+;;
+;; (defcommand mode-line-change-eol ((event)
+;;                                   :event)
+;;   "Cycle through the various possible kinds of end-of-line styles."
+;;   ;;(interactive "e")
+;;   (save-selected-window
+;;     (select-window (posn-window (event-start event)))
+;;     (let ((eol (coding-system-eol-type buffer-file-coding-system)))
+;;       (set-buffer-file-coding-system
+;;        (cond ((eq eol 0) 'dos) ((eq eol 1) 'mac) (t 'unix))))))
+;;
+;; (defvar mode-line-eol-desc-cache nil)
+;;
+;; (defun mode-line-eol-desc ()
+;;   (let* ((eol (coding-system-eol-type buffer-file-coding-system))
+;;      (mnemonic (coding-system-eol-type-mnemonic buffer-file-coding-system))
+;;      (desc (assq eol mode-line-eol-desc-cache)))
+;;     (el:if (and desc (eq (cadr desc) mnemonic))
+;;     (cddr desc)
+;;       (if desc (setq mode-line-eol-desc-cache nil)) ;Flush the cache if stale.
+;;       (setq desc
+;;         (propertize
+;;          mnemonic
+;;          'help-echo (format nil "~a end-of-line; mouse-1 to cycle"
+;;                             (if (eq eol 0) "Unix-style LF"
+;;                               (if (eq eol 1) "Dos-style CRLF"
+;;                                 (if (eq eol 2) "Mac-style CR"
+;;                                   "Undecided"))))
+;;          'keymap
+;;          ;;(eval-when-compile
+;;              #.(let ((map (make-sparse-keymap)))
+;;              (define-key map [mode-line mouse-1] 'mode-line-change-eol)
+;;              map)
+;;          'mouse-face 'mode-line-highlight))
+;;       (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
+;;       desc)))
+;;
+;; (defvar mode-line-mule-info
+;;   `(""
+;;     (current-input-method
+;;      (:propertize ("" current-input-method-title)
+;;               help-echo (concat
+;;                          "Input method: "
+;;                          current-input-method
+;;                          ".  mouse-2: disable, mouse-3: describe")
+;;               local-map ,mode-line-input-method-map
+;;               mouse-face mode-line-highlight))
+;;     ,(propertize
+;;       "%z"
+;;       'help-echo
+;;       #'(lambda (window object point)
+;;       (with-current-buffer (window-buffer window)
+;;         ;; Don't show this tip if the coding system is nil,
+;;         ;; it reads like a bug, and is not useful anyway.
+;;         (when buffer-file-coding-system
+;;           (if enable-multibyte-characters
+;;               (concat (symbol-name buffer-file-coding-system)
+;;                       " buffer; mouse-1: describe coding system")
+;;             (concat "Unibyte " (symbol-name buffer-file-coding-system)
+;;                     " buffer")))))
+;;       'mouse-face 'mode-line-highlight
+;;       'local-map mode-line-coding-system-map)
+;;     (:eval (mode-line-eol-desc)))
+;;   "Mode-line control for displaying information of multilingual environment.
+;; Normally it displays current input method (if any activated) and
+;; mnemonics of the following coding systems:
+;;   coding system for saving or writing the current buffer
+;;   coding system for keyboard input (if Emacs is running on terminal)
+;;   coding system for terminal output (if Emacs is running on terminal)"
+;;   ;; Currently not:
+;;   ;;  coding system for decoding output of buffer process (if any)
+;;   ;;  coding system for encoding text to send to buffer process (if any)."
+;; )
+;;
+;; (make-variable-buffer-local 'mode-line-mule-info)
+
+(defvar mode-line-frame-identification '("-%F  ")
+  "Mode-line control to describe the current frame.")
+
+(define-buffer-local mode-line-process nil "\
+Mode-line control for displaying info on process status.
+Normally nil in most modes, since there is no process to display.")
+
+(make-variable-buffer-local 'mode-line-process)
+
+(define-buffer-local mode-line-modified
+  (list (propertize
+        "%1*"
+        'help-echo (purecopy (lambda (window object point)
+                               (format nil "~sead-only: mouse-1 toggles"
+                                       (save-selected-window
+                                         (select-window window)
+                                         (if (buffer-read-only)
+                                             "R"
+                                           "Not r")))))
+        'local-map (purecopy (make-mode-line-mouse-map
+                              'mouse-1
+                              #'mode-line-toggle-read-only))
+        'mouse-face 'mode-line-highlight)
+       (propertize
+        "%1+"
+        'help-echo  (purecopy (lambda (window object point)
+                                (format nil "~sodified: mouse-1 toggles"
+                                        (save-selected-window
+                                          (select-window window)
+                                          (if (buffer-modified-p)
+                                            "M"
+                                          "Not m")))))
+        'local-map (purecopy (make-mode-line-mouse-map
+                              'mouse-1 #'mode-line-toggle-modified))
+        'mouse-face 'mode-line-highlight))
+  "Mode-line control for displaying whether current buffer is modified.")
+
+(make-variable-buffer-local 'mode-line-modified)
+
+;; Actual initialization is below.
+(defvar mode-line-position nil
+  "Mode-line control for displaying the position in the buffer.
+Normally displays the buffer percentage and, optionally, the
+buffer size, the line number and the column number.")
+
+(defvar mode-line-modes nil
+  "Mode-line control for displaying major and minor modes.")
+
+(defvar mode-line-major-mode-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map (make-click :where :mode-line :button :down-mouse-1) 'mouse-major-mode-menu)
+    (define-key map (make-click :where :mode-line :button :mouse-2) 'describe-mode)
+    (define-key map (make-click :where :mode-line :button :down-mouse-3) 'mode-line-mode-menu-1)
+    map) "\
+Keymap to display on major mode.")
+
+(defvar mode-line-minor-mode-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map (make-click :where :mode-line :button :mouse-2) 'mode-line-minor-mode-help)
+    (define-key map (make-click :where :mode-line :button :down-mouse-3) 'mode-line-mode-menu-1)
+    (define-key map (make-click :where :header-line :button :down-mouse-3) 'mode-line-mode-menu-1)
+    map) "\
+Keymap to display on minor modes.")
+
+;; FIXME: When our modeline formatting is up to snuff, uncomment -sabetts
+;; (let* ((help-echo
+;;     ;; The multi-line message doesn't work terribly well on the
+;;     ;; bottom mode line...  Better ideas?
+;;     ;;        "\
+;;     ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
+;;     ;; drag-mouse-1: resize, C-mouse-2: split horizontally"
+;;     "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this")
+;;        (dashes (propertize "--" 'help-echo help-echo))
+;;        (standard-mode-line-format
+;;     (list
+;;      "%e"
+;;      (propertize "-" 'help-echo help-echo)
+;;      'mode-line-mule-info
+;;      'mode-line-modified
+;;      'mode-line-frame-identification
+;;      'mode-line-buffer-identification
+;;      (propertize "   " 'help-echo help-echo)
+;;      'mode-line-position
+;;      '(vc-mode vc-mode)
+;;      (propertize "  " 'help-echo help-echo)
+;;      'mode-line-modes
+;;      `(which-func-mode ("" which-func-format ,dashes))
+;;      `(global-mode-string (,dashes global-mode-string))
+;;      (propertize "-%-" 'help-echo help-echo)))
+;;        (standard-mode-line-modes
+;;     (list
+;;      (propertize "%[(" 'help-echo help-echo)
+;;      `(:propertize ("" mode-name)
+;;                    help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes"
+;;                    mouse-face mode-line-highlight
+;;                    local-map ,mode-line-major-mode-keymap)
+;;      '("" mode-line-process)
+;;      `(:propertize ("" minor-mode-alist)
+;;                    mouse-face mode-line-highlight
+;;                    help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes"
+;;                    local-map ,mode-line-minor-mode-keymap)
+;;      (propertize "%n" 'help-echo "mouse-2: widen"
+;;                  'mouse-face 'mode-line-highlight
+;;                  'local-map (make-mode-line-mouse-map
+;;                              'mouse-2 #'mode-line-widen))
+;;      (propertize ")%]--" 'help-echo help-echo)))
+;;        (standard-mode-line-position
+;;     `((-3 ,(propertize "%p" 'help-echo help-echo))
+;;       (size-indication-mode
+;;        (8 ,(propertize " of %I" 'help-echo help-echo)))
+;;       (line-number-mode
+;;        ((column-number-mode
+;;          (10 ,(propertize " (%l,%c)" 'help-echo help-echo))
+;;          (6 ,(propertize " L%l" 'help-echo help-echo))))
+;;        ((column-number-mode
+;;          (5 ,(propertize " C%c" 'help-echo help-echo))))))))
+;;
+;;   (setq-default *mode-line-format* standard-mode-line-format)
+;;   (setf (get '*mode-line-format* 'standard-value)
+;;         (list `(quote ,standard-mode-line-format)))
+;;
+;;   (setq-default mode-line-modes standard-mode-line-modes)
+;;   (setf (get 'mode-line-modes 'standard-value)
+;;         (list `(quote ,standard-mode-line-modes)))
+;;
+;;   (setq-default mode-line-position standard-mode-line-position)
+;;   (setf (get 'mode-line-position 'standard-value)
+;;        (list `(quote ,standard-mode-line-position))))
+
+(defvar mode-line-buffer-identification-keymap nil "\
+Keymap for what is displayed by `mode-line-buffer-identification'.")
+
+;; Add menu of buffer operations to the buffer identification part
+;; of the mode line.or header line.
+;
+(let ((map (make-sparse-keymap)))
+  ;; Bind down- events so that the global keymap won't ``shine
+  ;; through''.
+  (define-key map (make-click :where :mode-line :button :mouse-1) 'mode-line-previous-buffer)
+  (define-key map (make-click :where :header-line :button :down-mouse-1) 'ignore)
+  (define-key map (make-click :where :header-line :button :mouse-1) 'mode-line-previous-buffer)
+  (define-key map (make-click :where :header-line :button :down-mouse-3) 'ignore)
+  (define-key map (make-click :where :mode-line :button :mouse-3) 'mode-line-next-buffer)
+  (define-key map (make-click :where :header-line :button :down-mouse-3) 'ignore)
+  (define-key map (make-click :where :header-line :button :mouse-3) 'mode-line-next-buffer)
+  (setq mode-line-buffer-identification-keymap map))
+
+(defun propertized-buffer-identification (fmt)
+  "Return a list suitable for `mode-line-buffer-identification'.
+FMT is a format specifier such as \"%12b\".  This function adds
+text properties for face, help-echo, and local-map to it."
+  (list (propertize fmt
+                   'face 'mode-line-buffer-id
+                   'help-echo
+                   (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
+                   'mouse-face 'mode-line-highlight
+                   'local-map mode-line-buffer-identification-keymap)))
+
+(define-buffer-local mode-line-buffer-identification (propertized-buffer-identification "%12b") "\
+Mode-line control for identifying the buffer being displayed.
+Its default value is (\"%12b\") with some text properties added.
+Major modes that edit things other than ordinary files may change this
+\(e.g. Info, Dired,...)")
+
+(make-variable-buffer-local 'mode-line-buffer-identification)
+
+(defcommand unbury-buffer () "\
+Switch to the last buffer in the buffer list."
+  (switch-to-buffer (last-buffer)))
+
+(defcommand mode-line-unbury-buffer ((event)
+                                     :event) "\
+Call `unbury-buffer' in this window."
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (unbury-buffer)))
+
+(defcommand mode-line-bury-buffer ((event)
+                                   :event)"\
+Like `bury-buffer', but temporarily select EVENT's window."
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (bury-buffer)))
+
+(defcommand mode-line-other-buffer () "\
+Switch to the most recently selected buffer other than the current one."
+  (switch-to-buffer (other-buffer)))
+
+(defcommand mode-line-next-buffer ((event)
+                                   :event)
+  "Like `next-buffer', but temporarily select EVENT's window."
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (next-buffer)))
+
+(defcommand mode-line-previous-buffer ((event)
+                                       :event)
+  "Like `previous-buffer', but temporarily select EVENT's window."
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (previous-buffer)))
+
+(defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\
+Menu of mode operations in the mode line.")
+
+(defcommand mode-line-mode-menu-1 ((event)
+                                   :event)
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (let* ((selection (mode-line-mode-menu event))
+          (binding (and selection (lookup-key mode-line-mode-menu
+                                              (vector (car selection))))))
+      (if binding
+         (call-interactively binding)))))
+
+(defmacro bound-and-true-p (var)
+  "Return the value of symbol VAR if it is bound, else nil."
+  `(and (boundp (quote ,var)) ,var))
+
+;; FIXME: when menu stuff is added uncomment this
+;; (define-key mode-line-mode-menu [overwrite-mode]
+;;   `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode
+;;           :button (:toggle . overwrite-mode)))
+;; (define-key mode-line-mode-menu [outline-minor-mode]
+;;   `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode
+;;           :button (:toggle . (bound-and-true-p outline-minor-mode))))
+;; (define-key mode-line-mode-menu [line-number-mode]
+;;   `(menu-item ,(purecopy "Line number") line-number-mode
+;;           :button (:toggle . line-number-mode)))
+;; (define-key mode-line-mode-menu [highlight-changes-mode]
+;;   `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode
+;;           :button (:toggle . (bound-and-true-p highlight-changes-mode))))
+;; (define-key mode-line-mode-menu [hide-ifdef-mode]
+;;   `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode
+;;           :button (:toggle . (bound-and-true-p hide-ifdef-mode))))
+;; (define-key mode-line-mode-menu [glasses-mode]
+;;   `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode
+;;           :button (:toggle . (bound-and-true-p glasses-mode))))
+;; (define-key mode-line-mode-menu [font-lock-mode]
+;;   `(menu-item ,(purecopy "Font Lock") font-lock-mode
+;;           :button (:toggle . font-lock-mode)))
+;; (define-key mode-line-mode-menu [flyspell-mode]
+;;   `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode
+;;           :button (:toggle . (bound-and-true-p flyspell-mode))))
+;; (define-key mode-line-mode-menu [column-number-mode]
+;;   `(menu-item ,(purecopy "Column number") column-number-mode
+;;           :button (:toggle . column-number-mode)))
+;; (define-key mode-line-mode-menu [auto-revert-tail-mode]
+;;   `(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode
+;;           :button (:toggle . (bound-and-true-p auto-revert-tail-mode))))
+;; (define-key mode-line-mode-menu [auto-revert-mode]
+;;   `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode
+;;           :button (:toggle . (bound-and-true-p auto-revert-mode))))
+;; (define-key mode-line-mode-menu [auto-fill-mode]
+;;   `(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode
+;;           :button (:toggle . auto-fill-function)))
+;; (define-key mode-line-mode-menu [abbrev-mode]
+;;   `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode
+;;           :button (:toggle . abbrev-mode)))
+
+(defun mode-line-mode-menu (event)
+  (interactive "@e")
+  (x-popup-menu event mode-line-mode-menu))
+
+(defun mode-line-minor-mode-help (event)
+  "Describe minor mode for EVENT occured on minor modes area of the mode line."
+  (interactive "@e")
+  (let ((indicator (car (nth 4 (car (cdr event))))))
+    (describe-minor-mode-from-indicator indicator)))
+
+(defvar minor-mode-alist nil "\
+Alist saying how to show minor modes in the mode line.
+Each element looks like (VARIABLE STRING);
+STRING is included in the mode line iff VARIABLE's value is non-nil.
+
+Actually, STRING need not be a string; any possible mode-line element
+is okay.  See `mode-line-format'.")
+;; Don't use purecopy here--some people want to change these strings.
+(setq minor-mode-alist
+      (list
+       (list 'abbrev-mode " Abbrev")
+       '(overwrite-mode overwrite-mode)
+       (list 'auto-fill-function " Fill")
+       ;; not really a minor mode...
+       '(defining-kbd-macro " Def")))
+
+;; These variables are used by autoloadable packages.
+;; They are defined here so that they do not get overridden
+;; by the loading of those packages.
+
+;; Names in directory that end in one of these
+;; are ignored in completion,
+;; making it more likely you will get a unique match.
+(setq completion-ignored-extensions
+      (append
+       (cond ((memq system-type '(ms-dos windows-nt))
+             '(".o" "~" ".bin" ".bak" ".obj" ".map" ".ico" ".pif" ".lnk"
+               ".a" ".ln" ".blg" ".bbl" ".dll" ".drv" ".vxd" ".386"))
+            ((eq system-type 'vax-vms)
+             '(".obj" ".exe" ".bin" ".lbin" ".sbin"
+               ".brn" ".rnt" ".lni"
+               ".olb" ".tlb" ".mlb" ".hlb"))
+            (t
+             '(".o" "~" ".bin" ".lbin" ".so"
+               ".a" ".ln" ".blg" ".bbl")))
+       '(".elc" ".lof"
+        ".glo" ".idx" ".lot"
+        ;; TeX-related
+        ".dvi" ".fmt" ".tfm" ".pdf"
+        ;; Java compiled
+        ".class"
+        ;; CLISP
+        ".fas" ".lib" ".mem"
+        ;; CMUCL
+        ".x86f" ".sparcf"
+         ;; Other CL implementations (Allegro, LispWorks, OpenMCL)
+         ".fasl" ".ufsl" ".fsl" ".dxl" ".pfsl" ".dfsl"
+        ;; Libtool
+        ".lo" ".la"
+        ;; Gettext
+        ".gmo" ".mo"
+        ;; Texinfo-related
+        ;; This used to contain .log, but that's commonly used for log
+        ;; files you do want to see, not just TeX stuff.  -- fx
+        ".toc" ".aux"
+        ".cp" ".fn" ".ky" ".pg" ".tp" ".vr"
+        ".cps" ".fns" ".kys" ".pgs" ".tps" ".vrs"
+        ;; Python byte-compiled
+        ".pyc" ".pyo")))
+
+;; Suffixes used for executables.
+(setq exec-suffixes
+      (cond
+       ((memq system-type '(ms-dos windows-nt))
+       '(".exe" ".com" ".bat" ".cmd" ".btm" ""))
+       (t
+       '(""))))
+
+;; Packages should add to this list appropriately when they are
+;; loaded, rather than listing everything here.
+(setq debug-ignored-errors
+      '(beginning-of-line beginning-of-buffer end-of-line
+       end-of-buffer end-of-file buffer-read-only
+       file-supersession
+       "^Previous command was not a yank$"
+       "^Minibuffer window is not active$"
+       "^No previous history search regexp$"
+       "^No later matching history item$"
+       "^No earlier matching history item$"
+       "^End of history; no default available$"
+       "^End of history; no next item$"
+       "^Beginning of history; no preceding item$"
+       "^No recursive edit is in progress$"
+       "^Changes to be undone are outside visible portion of buffer$"
+       "^No undo information in this buffer$"
+       "^No further undo information"
+       "^Save not confirmed$"
+       "^Recover-file cancelled\\.$"
+       "^Cannot switch buffers in a dedicated window$"
+        ))
+
+
+(make-variable-buffer-local 'indent-tabs-mode)
+
+;; We have base64 and md5 functions built in now.
+(provide 'base64)
+(provide 'md5)
+(provide 'overlay) ;;'(display syntax-table field))
+(provide 'text-properties) ;; '(display syntax-table field point-entered))
+
+(define-key *esc-map* "TAB" 'complete-symbol)
+
+(defcommand complete-symbol ((arg)
+                             :raw-prefix) "\
+Perform tags completion on the text around point.
+Completes to the set of names listed in the current tags table.
+The string to complete is chosen in the same way as the default
+for \\[find-tag] (which see).
+
+With a prefix argument, this command does completion within
+the collection of symbols listed in the index of the manual for the
+language you are using."
+  (if arg
+      (info-complete-symbol)
+    (if (fboundp 'complete-tag)
+       (complete-tag)
+      ;; Don't autoload etags if we have no tags table.
+      (error (substitute-command-keys
+             "No tags table loaded; use \\[visit-tags-table] to load one")))))
+
+;; Reduce total amount of space we must allocate during this function
+;; that we will not need to keep permanently.
+(garbage-collect)
+\f
+;; FIXME: figure out how cl charset stuff works and uncomment this code -sabetts
+;; Make all multibyte characters self-insert.
+;; (let ((l (generic-character-list))
+;;       (table (nth 1 *global-map*)))
+;;   (while l
+;;     (set-char-table-default table (car l) 'self-insert-command)
+;;     (setq l (cdr l))))
+
+(setq help-event-list '(help f1))
+
+(make-variable-buffer-local '*minor-mode-overriding-map-list*)
+
+;; From frame.c
+(global-set-key :switch-frame 'handle-switch-frame)
+(global-set-key :select-window 'handle-select-window)
+
+;; FIXME: Do those 3 events really ever reach the *global-map* ?
+;;        It seems that they can't because they're handled via
+;;        special-event-map which is used at very low-level.  -stef
+(global-set-key :delete-frame 'handle-delete-frame)
+(global-set-key :iconify-frame 'ignore-event)
+(global-set-key :make-frame-visible 'ignore-event)
+
+
+;These commands are defined in editfns.c
+;but they are not assigned to keys there.
+(setf (get 'narrow-to-region 'disabled) t)
+(define-key *ctl-x-map* "n n" 'narrow-to-region)
+(define-key *ctl-x-map* "n w" 'widen)
+;; (define-key *ctl-x-map* "n" 'narrow-to-region)
+;; (define-key *ctl-x-map* "w" 'widen)
+
+;; Quitting
+(define-key *global-map* "ESC ESC ESC" 'keyboard-escape-quit)
+(define-key *global-map* "C-g" 'keyboard-quit)
+
+(define-key *global-map* "C-j" 'newline-and-indent)
+(define-key *global-map* "C-m" 'newline)
+(define-key *global-map* "C-o" 'open-line)
+(define-key *esc-map* "C-o" 'split-line)
+(define-key *global-map* "C-q" 'quoted-insert)
+(define-key *esc-map* "^" 'delete-indentation)
+(define-key *esc-map* "\\" 'delete-horizontal-space)
+(define-key *esc-map* "m" 'back-to-indentation)
+(define-key *ctl-x-map* "C-o" 'delete-blank-lines)
+(define-key *esc-map* " " 'just-one-space)
+(define-key *esc-map* "z" 'zap-to-char)
+(define-key *esc-map* "=" 'count-lines-region)
+(define-key *ctl-x-map* "=" 'what-cursor-position)
+(define-key *esc-map* ":" 'eval-expression)
+;; Define ESC ESC : like ESC : for people who type ESC ESC out of habit.
+(define-key *esc-map* (kbd "M-:") 'eval-expression)
+;; Changed from C-x ESC so that function keys work following C-x.
+(define-key *ctl-x-map* "\e\e" 'repeat-complex-command)
+;; New binding analogous to M-:.
+(define-key *ctl-x-map* "\M-:" 'repeat-complex-command)
+(define-key *ctl-x-map* "u" 'advertised-undo)
+;; Many people are used to typing C-/ on X terminals and getting C-_.
+(define-key *global-map* "C-/" 'undo)
+(define-key *global-map* "C-_" 'undo)
+;; Richard said that we should not use C-x <uppercase letter> and I have
+;; no idea whereas to bind it.  Any suggestion welcome.  -stef
+;; (define-key *ctl-x-map* "U" 'undo-only)
+
+(define-key *esc-map* "!" 'shell-command)
+(define-key *esc-map* "|" 'shell-command-on-region)
+
+(define-key *global-map* "C-x right" 'next-buffer)
+(define-key *global-map* "C-x C-right" 'next-buffer)
+(define-key *global-map* "C-x left" 'previous-buffer)
+(define-key *global-map* "C-x C-left" 'previous-buffer)
+
+(let ((map *minibuffer-local-map*))
+  (define-key map "M-n"   'next-history-element)
+  (define-key map :next  'next-history-element)
+  (define-key map :down  'next-history-element)
+  (define-key map "M-p"   'previous-history-element)
+  (define-key map :prior 'previous-history-element)
+  (define-key map :up    'previous-history-element)
+  (define-key map "M-s"   'next-matching-history-element)
+  (define-key map "M-r"   'previous-matching-history-element)
+  ;; Override the global binding (which calls indent-relative via
+  ;; indent-for-tab-command).  The alignment that indent-relative tries to
+  ;; do doesn't make much sense here since the prompt messes it up.
+  (define-key map "TAB"    'self-insert-command))
+
+(define-key *global-map* "C-u" 'universal-argument)
+(loop for i from 0 to 9 do
+     (define-key *esc-map* (format nil "~d" i) 'digit-argument))
+(define-key *esc-map* "-" 'negative-argument)
+;; Define control-digits.
+(loop for i from 0 to 9 do
+     (define-key *global-map* (format nil "C-~d" i) 'digit-argument))
+(define-key *global-map* "C--" 'negative-argument)
+;; Define control-meta-digits.
+(loop for i from 0 to 9 do
+    (define-key *esc-map* (format nil "C-~d" i) 'digit-argument))
+(define-key *global-map* "C-M--" 'negative-argument)
+
+(define-key *global-map* "C-k" 'kill-line)
+(define-key *global-map* "C-w" 'kill-region)
+(define-key *esc-map* "w" 'kill-ring-save)
+(define-key *esc-map* "C-w" 'append-next-kill)
+(define-key *global-map* "C-y" 'yank)
+(define-key *esc-map* "y" 'yank-pop)
+
+;; (define-key *ctl-x-map* "a" 'append-to-buffer)
+
+(define-key *global-map* "C-@" 'set-mark-command)
+;; Many people are used to typing C-SPC and getting C-@.
+(define-key *global-map* "C-SPC" 'set-mark-command)
+(define-key *ctl-x-map* "C-x" 'exchange-point-and-mark)
+(define-key *ctl-x-map* "C-@" 'pop-global-mark)
+(define-key *ctl-x-map* "C-SPC" 'pop-global-mark)
+
+(define-key *global-map* "C-n" 'next-line)
+(define-key *global-map* "C-p" 'previous-line)
+(define-key *ctl-x-map* "C-n" 'set-goal-column)
+(define-key *global-map* "C-a" 'move-beginning-of-line)
+(define-key *global-map* "C-e" 'move-end-of-line)
+(define-key *esc-map* "g" (make-sparse-keymap))
+(define-key *esc-map* "g M-g" 'goto-line)
+(define-key *esc-map* "g g" 'goto-line)
+
+(define-key *esc-map* "g n" 'next-error)
+(define-key *esc-map* "g M-n" 'next-error)
+(define-key *ctl-x-map* "`" 'next-error)
+
+(define-key *esc-map* "g p" 'previous-error)
+(define-key *esc-map* "g M-p" 'previous-error)
+
+;;(defun function-key-error ()
+;;  (interactive)
+;;  (error "That function key is not bound to anything"))
+
+(define-key *global-map* :menu 'execute-extended-command)
+(define-key *global-map* :find 'search-forward)
+
+;; Don't do this.  We define <delete> in *function-key-map* instead.
+;(define-key *global-map* [delete] 'backward-delete-char)
+
+;; natural bindings for terminal keycaps --- defined in X keysym order
+(define-key *global-map* "C-S-backspace"  'kill-whole-line)
+(define-key *global-map* "home"                'move-beginning-of-line)
+(define-key *global-map* "C-home"              'beginning-of-buffer)
+(define-key *global-map* "M-home"              'beginning-of-buffer-other-window)
+(define-key *esc-map*    "home"                'beginning-of-buffer-other-window)
+(define-key *global-map* "left"                'backward-char)
+(define-key *global-map* "up"          'previous-line)
+(define-key *global-map* "right"               'forward-char)
+(define-key *global-map* "down"                'next-line)
+(define-key *global-map* "prior"               'scroll-down)
+(define-key *global-map* "next"                'scroll-up)
+(define-key *global-map* "C-up"                'backward-paragraph)
+(define-key *global-map* "C-down"              'forward-paragraph)
+(define-key *global-map* "C-prior"     'scroll-right)
+(setf (get 'scroll-left 'disabled) t)
+(define-key *global-map* "C-next"              'scroll-left)
+(define-key *global-map* "M-next"              'scroll-other-window)
+(define-key *esc-map*    "next"                'scroll-other-window)
+(define-key *global-map* "M-prior"     'scroll-other-window-down)
+(define-key *esc-map*    "prior"               'scroll-other-window-down)
+(define-key *esc-map* "?\C-\S-v"               'scroll-other-window-down)
+(define-key *global-map* "end"         'move-end-of-line)
+(define-key *global-map* "C-end"               'end-of-buffer)
+(define-key *global-map* "M-end"               'end-of-buffer-other-window)
+(define-key *esc-map*    "end"         'end-of-buffer-other-window)
+(define-key *global-map* "begin"               'beginning-of-buffer)
+(define-key *global-map* "M-begin"     'beginning-of-buffer-other-window)
+(define-key *esc-map*    "begin"               'beginning-of-buffer-other-window)
+;; (define-key *global-map* "select"   'function-key-error)
+;; (define-key *global-map* "print"    'function-key-error)
+(define-key *global-map* "execute"     'execute-extended-command)
+(define-key *global-map* "insert"              'overwrite-mode)
+(define-key *global-map* "C-insert"    'kill-ring-save)
+(define-key *global-map* "S-insert"    'yank)
+;; `insertchar' is what term.c produces.  Should we change term.c
+;; to produce `insert' instead?
+(define-key *global-map* "insertchar"  'overwrite-mode)
+(define-key *global-map* "C-insertchar"        'kill-ring-save)
+(define-key *global-map* "S-insertchar"        'yank)
+(define-key *global-map* "undo"                'undo)
+(define-key *global-map* "redo"                'repeat-complex-command)
+(define-key *global-map* "again"               'repeat-complex-command) ; Sun keyboard
+(define-key *global-map* "open"                'find-file) ; Sun
+;; The following wouldn't work to interrupt running code since C-g is
+;; treated specially in the event loop.
+;; (define-key *global-map* "stop"             'keyboard-quit) ; Sun
+;; (define-key *global-map* "clearline"        'function-key-error)
+(define-key *global-map* "insertline"  'open-line)
+(define-key *global-map* "deleteline"  'kill-line)
+(define-key *global-map* "deletechar"  'delete-char)
+;; (define-key *global-map* "backtab"  'function-key-error)
+;; (define-key *global-map* "f1"               'function-key-error)
+;; (define-key *global-map* "f2"               'function-key-error)
+;; (define-key *global-map* "f3"               'function-key-error)
+;; (define-key *global-map* "f4"               'function-key-error)
+;; (define-key *global-map* "f5"               'function-key-error)
+;; (define-key *global-map* "f6"               'function-key-error)
+;; (define-key *global-map* "f7"               'function-key-error)
+;; (define-key *global-map* "f8"               'function-key-error)
+;; (define-key *global-map* "f9"               'function-key-error)
+;; (define-key *global-map* "f10"              'function-key-error)
+;; (define-key *global-map* "f11"              'function-key-error)
+;; (define-key *global-map* "f12"              'function-key-error)
+;; (define-key *global-map* "f13"              'function-key-error)
+;; (define-key *global-map* "f14"              'function-key-error)
+;; (define-key *global-map* "f15"              'function-key-error)
+;; (define-key *global-map* "f16"              'function-key-error)
+;; (define-key *global-map* "f17"              'function-key-error)
+;; (define-key *global-map* "f18"              'function-key-error)
+;; (define-key *global-map* "f19"              'function-key-error)
+;; (define-key *global-map* "f20"              'function-key-error)
+;; (define-key *global-map* "f21"              'function-key-error)
+;; (define-key *global-map* "f22"              'function-key-error)
+;; (define-key *global-map* "f23"              'function-key-error)
+;; (define-key *global-map* "f24"              'function-key-error)
+;; (define-key *global-map* "f25"              'function-key-error)
+;; (define-key *global-map* "f26"              'function-key-error)
+;; (define-key *global-map* "f27"              'function-key-error)
+;; (define-key *global-map* "f28"              'function-key-error)
+;; (define-key *global-map* "f29"              'function-key-error)
+;; (define-key *global-map* "f30"              'function-key-error)
+;; (define-key *global-map* "f31"              'function-key-error)
+;; (define-key *global-map* "f32"              'function-key-error)
+;; (define-key *global-map* "f33"              'function-key-error)
+;; (define-key *global-map* "f34"              'function-key-error)
+;; (define-key *global-map* "f35"              'function-key-error)
+;; (define-key *global-map* "kp-backtab"       'function-key-error)
+;; (define-key *global-map* "kp-space" 'function-key-error)
+;; (define-key *global-map* "kp-tab"           'function-key-error)
+;; (define-key *global-map* "kp-enter" 'function-key-error)
+;; (define-key *global-map* "kp-f1"            'function-key-error)
+;; (define-key *global-map* "kp-f2"            'function-key-error)
+;; (define-key *global-map* "kp-f3"            'function-key-error)
+;; (define-key *global-map* "kp-f4"            'function-key-error)
+;; (define-key *global-map* "kp-multiply"      'function-key-error)
+;; (define-key *global-map* "kp-add"           'function-key-error)
+;; (define-key *global-map* "kp-separator"     'function-key-error)
+;; (define-key *global-map* "kp-subtract"      'function-key-error)
+;; (define-key *global-map* "kp-decimal"       'function-key-error)
+;; (define-key *global-map* "kp-divide"        'function-key-error)
+;; (define-key *global-map* "kp-0"             'function-key-error)
+;; (define-key *global-map* "kp-1"             'function-key-error)
+;; (define-key *global-map* "kp-2"             'function-key-error)
+;; (define-key *global-map* "kp-3"             'function-key-error)
+;; (define-key *global-map* "kp-4"             'function-key-error)
+;; (define-key *global-map* "kp-5"             'recenter)
+;; (define-key *global-map* "kp-6"             'function-key-error)
+;; (define-key *global-map* "kp-7"             'function-key-error)
+;; (define-key *global-map* "kp-8"             'function-key-error)
+;; (define-key *global-map* "kp-9"             'function-key-error)
+;; (define-key *global-map* "kp-equal" 'function-key-error)
+
+;; X11R6 distinguishes these keys from the non-kp keys.
+;; Make them behave like the non-kp keys unless otherwise bound.
+(define-key *function-key-map* "kp-home" "home")
+(define-key *function-key-map* "kp-left" "left")
+(define-key *function-key-map* "kp-up" "up")
+(define-key *function-key-map* "kp-right" "right")
+(define-key *function-key-map* "kp-down" "down")
+(define-key *function-key-map* "kp-prior" "prior")
+(define-key *function-key-map* "kp-next" "next")
+(define-key *function-key-map* "M-kp-next" "M-next")
+(define-key *function-key-map* "kp-end" "end")
+(define-key *function-key-map* "kp-begin" "begin")
+(define-key *function-key-map* "kp-insert" "insert")
+(define-key *function-key-map* "backspace" "?\C-?")
+(define-key *function-key-map* "delete" "?\C-?")
+(define-key *function-key-map* "kp-delete" "?\C-?")
+(define-key *function-key-map* "S-kp-end" "S-end")
+(define-key *function-key-map* "S-kp-down" "S-down")
+(define-key *function-key-map* "S-kp-next" "S-next")
+(define-key *function-key-map* "S-kp-left" "S-left")
+(define-key *function-key-map* "S-kp-right" "S-right")
+(define-key *function-key-map* "S-kp-home" "S-home")
+(define-key *function-key-map* "S-kp-up" "S-up")
+(define-key *function-key-map* "S-kp-prior" "S-prior")
+(define-key *function-key-map* "C-S-kp-end" "C-S-end")
+(define-key *function-key-map* "C-S-kp-down" "C-S-down")
+(define-key *function-key-map* "C-S-kp-next" "C-S-next")
+(define-key *function-key-map* "C-S-kp-left" "C-S-left")
+(define-key *function-key-map* "C-S-kp-right" "C-S-right")
+(define-key *function-key-map* "C-S-kp-home" "C-S-home")
+(define-key *function-key-map* "C-S-kp-up" "C-S-up")
+(define-key *function-key-map* "C-S-kp-prior" "C-S-prior")
+;; Don't bind shifted keypad numeric keys, they reportedly
+;; interfere with the feature of some keyboards to produce
+;; numbers when NumLock is off.
+;(define-key *function-key-map* "S-kp-1" "S-end")
+;(define-key *function-key-map* "S-kp-2" "S-down")
+;(define-key *function-key-map* "S-kp-3" "S-next")
+;(define-key *function-key-map* "S-kp-4" "S-left")
+;(define-key *function-key-map* "S-kp-6" "S-right")
+;(define-key *function-key-map* "S-kp-7" "S-home")
+;(define-key *function-key-map* "S-kp-8" "S-up")
+;(define-key *function-key-map* "S-kp-9" "S-prior")
+(define-key *function-key-map* "C-S-kp-1" "C-S-end")
+(define-key *function-key-map* "C-S-kp-2" "C-S-down")
+(define-key *function-key-map* "C-S-kp-3" "C-S-next")
+(define-key *function-key-map* "C-S-kp-4" "C-S-left")
+(define-key *function-key-map* "C-S-kp-6" "C-S-right")
+(define-key *function-key-map* "C-S-kp-7" "C-S-home")
+(define-key *function-key-map* "C-S-kp-8" "C-S-up")
+(define-key *function-key-map* "C-S-kp-9" "C-S-prior")
+
+(define-key *global-map* "mouse-movement" 'ignore)
+
+(define-key *global-map* "C-t" 'transpose-chars)
+(define-key *esc-map* "t" 'transpose-words)
+(define-key *esc-map* "C-t" 'transpose-sexps)
+(define-key *ctl-x-map* "C-t" 'transpose-lines)
+
+(define-key *esc-map* ";" 'comment-dwim)
+(define-key *esc-map* "j" 'indent-new-comment-line)
+(define-key *esc-map* "C-j" 'indent-new-comment-line)
+(define-key *ctl-x-map* ";" 'comment-set-column)
+(define-key *ctl-x-map* "f" 'set-fill-column)
+(define-key *ctl-x-map* "$" 'set-selective-display)
+
+(define-key *esc-map* "@" 'mark-word)
+(define-key *esc-map* "f" 'forward-word)
+(define-key *esc-map* "b" 'backward-word)
+(define-key *esc-map* "d" 'kill-word)
+(define-key *esc-map* "\177" 'backward-kill-word)
+
+(define-key *esc-map* "<" 'beginning-of-buffer)
+(define-key *esc-map* ">" 'end-of-buffer)
+(define-key *ctl-x-map* "h" 'mark-whole-buffer)
+(define-key *esc-map* "\\" 'delete-horizontal-space)
+
+(defvar mode-specific-command-prefix (make-sparse-keymap))
+(defvar mode-specific-map mode-specific-command-prefix
+  "Keymap for characters following C-c.")
+(define-key *global-map* "C-c" 'mode-specific-command-prefix)
+
+(global-set-key "M-right"  'forward-word)
+(define-key *esc-map* "right" 'forward-word)
+(global-set-key "M-left"   'backward-word)
+(define-key *esc-map* "left" 'backward-word)
+;; ilya@math.ohio-state.edu says these bindings are standard on PC editors.
+(global-set-key "C-right"  'forward-word)
+(global-set-key "C-left"   'backward-word)
+;; This is not quite compatible, but at least is analogous
+(global-set-key "C-delete" 'backward-kill-word)
+(global-set-key "C-backspace" 'kill-word)
+;; This is "move to the clipboard", or as close as we come.
+(global-set-key "S-delete" 'kill-region)
+
+(global-set-key "C-M-left"    'backward-sexp)
+(define-key *esc-map* "C-left"  'backward-sexp)
+(global-set-key "C-M-right"   'forward-sexp)
+(define-key *esc-map* "C-right" 'forward-sexp)
+(global-set-key "C-M-up"      'backward-up-list)
+(define-key *esc-map* "C-up"    'backward-up-list)
+(global-set-key "C-M-down"    'down-list)
+(define-key *esc-map* "C-down"  'down-list)
+(global-set-key "C-M-home"    'beginning-of-defun)
+(define-key *esc-map* "C-home"  'beginning-of-defun)
+(global-set-key "C-M-end"     'end-of-defun)
+(define-key *esc-map* "C-end"   'end-of-defun)
+
+(define-key *esc-map* "C-f" 'forward-sexp)
+(define-key *esc-map* "C-b" 'backward-sexp)
+(define-key *esc-map* "C-u" 'backward-up-list)
+(define-key *esc-map* "C-@" 'mark-sexp)
+(define-key *esc-map* "C-SPC" 'mark-sexp)
+(define-key *esc-map* "C-d" 'down-list)
+(define-key *esc-map* "C-k" 'kill-sexp)
+;;; These are dangerous in various situations,
+;;; so let's not encourage anyone to use them.
+;;;(define-key *global-map* "C-M-delete" 'backward-kill-sexp)
+;;;(define-key *global-map* "C-M-backspace" 'backward-kill-sexp)
+(define-key *esc-map* "C-delete" 'backward-kill-sexp)
+(define-key *esc-map* "C-backspace" 'backward-kill-sexp)
+(define-key *esc-map* "C-n" 'forward-list)
+(define-key *esc-map* "C-p" 'backward-list)
+(define-key *esc-map* "C-a" 'beginning-of-defun)
+(define-key *esc-map* "C-e" 'end-of-defun)
+(define-key *esc-map* "C-h" 'mark-defun)
+(define-key *ctl-x-map* "n d" 'narrow-to-defun)
+(define-key *esc-map* "(" 'insert-parentheses)
+(define-key *esc-map* ")" 'move-past-close-and-reindent)
+
+(define-key *ctl-x-map* "C-e" 'eval-last-sexp)
+
+(define-key *ctl-x-map* "m" 'compose-mail)
+(define-key *ctl-x-4-map* "m" 'compose-mail-other-window)
+(define-key *ctl-x-5-map* "m" 'compose-mail-other-frame)
+\f
+(define-key *ctl-x-map* "r C-@" 'point-to-register)
+(define-key *ctl-x-map* "r C-SPC" 'point-to-register)
+(define-key *ctl-x-map* "r SPC" 'point-to-register)
+(define-key *ctl-x-map* "r j" 'jump-to-register)
+(define-key *ctl-x-map* "r s" 'copy-to-register)
+(define-key *ctl-x-map* "r x" 'copy-to-register)
+(define-key *ctl-x-map* "r i" 'insert-register)
+(define-key *ctl-x-map* "r g" 'insert-register)
+(define-key *ctl-x-map* "r r" 'copy-rectangle-to-register)
+(define-key *ctl-x-map* "r n" 'number-to-register)
+(define-key *ctl-x-map* "r +" 'increment-register)
+(define-key *ctl-x-map* "r c" 'clear-rectangle)
+(define-key *ctl-x-map* "r k" 'kill-rectangle)
+(define-key *ctl-x-map* "r d" 'delete-rectangle)
+(define-key *ctl-x-map* "r y" 'yank-rectangle)
+(define-key *ctl-x-map* "r o" 'open-rectangle)
+(define-key *ctl-x-map* "r t" 'string-rectangle)
+(define-key *ctl-x-map* "r w" 'window-configuration-to-register)
+(define-key *ctl-x-map* "r f" 'frame-configuration-to-register)
+
+;; ;; These key bindings are deprecated; use the above C-x r map instead.
+;; ;; We use these aliases so \[...] will show the C-x r bindings instead.
+;; (defalias 'point-to-register-compatibility-binding 'point-to-register)
+;; (defalias 'jump-to-register-compatibility-binding 'jump-to-register)
+;; (defalias 'copy-to-register-compatibility-binding 'copy-to-register)
+;; (defalias 'insert-register-compatibility-binding 'insert-register)
+;; (define-key *ctl-x-map* "/" 'point-to-register-compatibility-binding)
+;; (define-key *ctl-x-map* "j" 'jump-to-register-compatibility-binding)
+;; (define-key *ctl-x-map* "x" 'copy-to-register-compatibility-binding)
+;; (define-key *ctl-x-map* "g" 'insert-register-compatibility-binding)
+;; (define-key *ctl-x-map* "r" 'copy-rectangle-to-register)
+
+(define-key *esc-map* "q" 'fill-paragraph)
+;; (define-key *esc-map* "g" 'fill-region)
+(define-key *ctl-x-map* "." 'set-fill-prefix)
+\f
+(define-key *esc-map* "{" 'backward-paragraph)
+(define-key *esc-map* "}" 'forward-paragraph)
+(define-key *esc-map* "h" 'mark-paragraph)
+(define-key *esc-map* "a" 'backward-sentence)
+(define-key *esc-map* "e" 'forward-sentence)
+(define-key *esc-map* "k" 'kill-sentence)
+(define-key *ctl-x-map* "DEL" 'backward-kill-sentence)
+
+(define-key *ctl-x-map* "[" 'backward-page)
+(define-key *ctl-x-map* "]" 'forward-page)
+(define-key *ctl-x-map* "C-p" 'mark-page)
+(define-key *ctl-x-map* "l" 'count-lines-page)
+(define-key *ctl-x-map* "n p" 'narrow-to-page)
+;; (define-key *ctl-x-map* "p" 'narrow-to-page)
+\f
+(define-key *ctl-x-map* "a l" 'add-mode-abbrev)
+(define-key *ctl-x-map* "a C-a" 'add-mode-abbrev)
+(define-key *ctl-x-map* "a g" 'add-global-abbrev)
+(define-key *ctl-x-map* "a +" 'add-mode-abbrev)
+(define-key *ctl-x-map* "a i g" 'inverse-add-global-abbrev)
+(define-key *ctl-x-map* "a i l" 'inverse-add-mode-abbrev)
+;; (define-key *ctl-x-map* "a\C-h" 'inverse-add-global-abbrev)
+(define-key *ctl-x-map* "a -" 'inverse-add-global-abbrev)
+(define-key *ctl-x-map* "a e" 'expand-abbrev)
+(define-key *ctl-x-map* "a '" 'expand-abbrev)
+;; (define-key *ctl-x-map* "\C-a" 'add-mode-abbrev)
+;; (define-key *ctl-x-map* "\+" 'add-global-abbrev)
+;; (define-key *ctl-x-map* "\C-h" 'inverse-add-mode-abbrev)
+;; (define-key *ctl-x-map* "\-" 'inverse-add-global-abbrev)
+(define-key *esc-map* "'" 'abbrev-prefix-mark)
+(define-key *ctl-x-map* "'" 'expand-abbrev)
+
+(define-key *ctl-x-map* "z" 'repeat)
+
+(define-key *ctl-x-4-map* "c" 'clone-indirect-buffer-other-window)
+
+;; Don't look for autoload cookies in this file.
+;; Local Variables:
+;; no-update-autoloads: t
+;; End:
+
+;; arch-tag: 23b5c7e6-e47b-49ed-8c6c-ed213c5fffe0
+;;; bindings.el ends here
index 04a099a..cd2b4a1 100644 (file)
@@ -232,8 +232,269 @@ STRING should be given if the last search was by `string-match' on STRING."
 With optional non-nil ALL, force redisplay of all mode lines and
 header lines.  This function also forces recomputation of the
 menu bar menus and the frame title."
+  (declare (ignore all))
+  (error "unimplemented")
 ;;   (if all (save-excursion (set-buffer (other-buffer))))
 ;;   (set-buffer-modified-p (buffer-modified-p))
   )
 
+(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
+  "Register a new minor mode.
+
+This is an XEmacs-compatibility function.  Use `define-minor-mode' instead.
+
+TOGGLE is a symbol which is the name of a buffer-local variable that
+is toggled on or off to say whether the minor mode is active or not.
+
+NAME specifies what will appear in the mode line when the minor mode
+is active.  NAME should be either a string starting with a space, or a
+symbol whose value is such a string.
+
+Optional KEYMAP is the keymap for the minor mode that will be added
+to `*minor-mode-map-list*'.
+
+Optional AFTER specifies that TOGGLE should be added after AFTER
+in `*minor-mode-list*'.
+
+Optional TOGGLE-FUN is an interactive function to toggle the mode.
+It defaults to (and should by convention be) TOGGLE.
+
+If TOGGLE has a non-nil `:included' property, an entry for the mode is
+included in the mode-line minor mode menu.
+If TOGGLE has a `:menu-tag', that is used for the menu item's label."
+  (unless (memq toggle minor-mode-list)
+    (push toggle minor-mode-list))
+
+  (unless toggle-fun (setq toggle-fun toggle))
+  (unless (eq toggle-fun toggle)
+    (setf (get toggle :minor-mode-function) toggle-fun))
+  ;; Add the name to the *minor-mode-list*.
+  (when name
+    (let ((existing (find toggle *minor-mode-list* :key 'first)))
+      (if existing
+         (setf (cdr existing) (list name))
+       (let ((found (member after *minor-mode-list* :key 'first)))
+         (if found
+             (let ((rest (cdr found)))
+               (setf (cdr found) nil)
+               (nconc found (list (list toggle name)) rest))
+              (push (cons (list toggle name)
+                          *minor-mode-list*) *minor-mode-list*))))))
+;; FIXME: when menu support is added, use this code
+;;   ;; Add the toggle to the minor-modes menu if requested.
+;;   (when (get toggle :included)
+;;     (define-key mode-line-mode-menu
+;;       (vector toggle)
+;;       (list 'menu-item
+;;         (concat
+;;          (or (get toggle :menu-tag)
+;;              (if (stringp name) name (symbol-name toggle)))
+;;          (let ((mode-name (if (symbolp name) (symbol-value name))))
+;;            (if (and (stringp mode-name) (string-match "[^ ]+" mode-name))
+;;                (concat " (" (match-string 0 mode-name) ")"))))
+;;         toggle-fun
+;;         :button (cons :toggle toggle))))
+
+  ;; Add the map to the *minor-mode-map-list*.
+  (when keymap
+    (let ((existing (find toggle *minor-mode-map-list* :key 'minor-mode-map-variable)))
+      (if existing
+         (setf (minor-mode-map-keymap existing) keymap)
+       (let ((found (member after *minor-mode-map-list* :key 'minor-mode-map-variable)))
+         (if found
+             (let ((rest (cdr found)))
+               (setf (cdr found) nil)
+               (nconc found (list (make-minor-mode-map :variable toggle :keymap keymap)) rest))
+           (push (make-minor-mode-map :variable toggle :keymap keymap)
+                  *minor-mode-map-list*)))))))
+
+
+(defun replace-regexp-in-string (regexp rep string &optional
+                                 fixedcase literal subexp start)
+  "Replace all matches for REGEXP with REP in STRING.
+
+Return a new string containing the replacements.
+
+Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
+arguments with the same names of function `replace-match'.  If START
+is non-nil, start replacements at that index in STRING.
+
+REP is either a string used as the NEWTEXT arg of `replace-match' or a
+function.  If it is a function, it is called with the actual text of each
+match, and its value is used as the replacement text.  When REP is called,
+the match-data are the result of matching REGEXP against a substring
+of STRING.
+
+To replace only the first match (if any), make REGEXP match up to \\'
+and replace a sub-expression, e.g.
+  (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
+    => \" bar foo\"
+"
+
+  ;; To avoid excessive consing from multiple matches in long strings,
+  ;; don't just call `replace-match' continually.  Walk down the
+  ;; string looking for matches of REGEXP and building up a (reversed)
+  ;; list MATCHES.  This comprises segments of STRING which weren't
+  ;; matched interspersed with replacements for segments that were.
+  ;; [For a `large' number of replacements it's more efficient to
+  ;; operate in a temporary buffer; we can't tell from the function's
+  ;; args whether to choose the buffer-based implementation, though it
+  ;; might be reasonable to do so for long enough STRING.]
+  (let ((l (length string))
+       (start (or start 0))
+       matches str mb me)
+    (with-match-data
+      (while (and (< start l) (string-match regexp string start))
+       (setq mb (match-beginning 0)
+             me (match-end 0))
+       ;; If we matched the empty string, make sure we advance by one char
+       (when (= me mb) (setq me (min l (1+ mb))))
+       ;; Generate a replacement for the matched substring.
+       ;; Operate only on the substring to minimize string consing.
+       ;; Set up match data for the substring for replacement;
+       ;; presumably this is likely to be faster than munging the
+       ;; match data directly in Lisp.
+       (string-match regexp (setq str (substring string mb me)))
+       (setq matches
+             (cons (replace-match (if (stringp rep)
+                                      rep
+                                    (funcall rep (match-string 0 str)))
+                                  fixedcase literal str subexp)
+                   (cons (substring string start mb)       ; unmatched prefix
+                         matches)))
+       (setq start me))
+      ;; Reconstruct a string from the pieces.
+      (setq matches (cons (substring string start l) matches)) ; leftover
+      (apply #'concat (nreverse matches)))))
+
+\f
+;;;; Key binding commands.
+
+(defcommand global-set-key ((key command)
+                            (:key "Set key globally: ")
+                            (:command "Set key ~a to command: "))
+  "Give KEY a global binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+KEY is a key sequence; noninteractively, it is a string or vector
+of characters or event types, and non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+
+Note that if KEY has a local binding in the current buffer,
+that local binding will continue to shadow any global binding
+that you make with this function."
+  ;;(interactive "KSet key globally: \nCSet key %s to command: ")
+  (or (vectorp key) (stringp key) (symbolp key) (clickp key)
+      (signal 'wrong-type-argument :type (list 'arrayp key)))
+  (define-key (current-global-map) key command))
+
+(defcommand local-set-key ((key command)
+                           (:key "Set key locally: ")
+                           (:command "Set key ~a locally to command: "))
+  "Give KEY a local binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+KEY is a key sequence; noninteractively, it is a string or vector
+of characters or event types, and non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+
+The binding goes in the current buffer's local map,
+which in most cases is shared with all other buffers in the same major mode."
+  ;;(interactive "KSet key locally: \nCSet key %s locally to command: ")
+  (let ((map (current-local-map)))
+    (or map
+       (use-local-map (setq map (make-sparse-keymap))))
+    (or (vectorp key) (stringp key)
+       (signal 'wrong-type-argument (list 'arrayp key)))
+    (define-key map key command)))
+
+(defun global-unset-key (key)
+  "Remove global binding of KEY.
+KEY is a string or vector representing a sequence of keystrokes."
+  (interactive "kUnset key globally: ")
+  (global-set-key key nil))
+
+(defun local-unset-key (key)
+  "Remove local binding of KEY.
+KEY is a string or vector representing a sequence of keystrokes."
+  (interactive "kUnset key locally: ")
+  (if (current-local-map)
+      (local-set-key key nil))
+  nil)
+
+\f
+;;;; substitute-key-definition and its subroutines.
+
+(defvar key-substitution-in-progress nil
+ "Used internally by `substitute-key-definition'.")
+
+(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
+  "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+In other words, OLDDEF is replaced with NEWDEF where ever it appears.
+Alternatively, if optional fourth argument OLDMAP is specified, we redefine
+in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
+
+If you don't specify OLDMAP, you can usually get the same results
+in a cleaner way with command remapping, like this:
+  \(define-key KEYMAP [remap OLDDEF] NEWDEF)
+\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
+  ;; Don't document PREFIX in the doc string because we don't want to
+  ;; advertise it.  It's meant for recursive calls only.  Here's its
+  ;; meaning
+
+  ;; If optional argument PREFIX is specified, it should be a key
+  ;; prefix, a string.  Redefined bindings will then be bound to the
+  ;; original key, with PREFIX added at the front.
+  (or prefix (setq prefix ""))
+  (let* ((scan (or oldmap keymap))
+        (prefix1 (vconcat prefix [nil]))
+        (key-substitution-in-progress
+         (cons scan key-substitution-in-progress)))
+    ;; Scan OLDMAP, finding each char or event-symbol that
+    ;; has any definition, and act on it with hack-key.
+    (map-keymap
+     (lambda (char defn)
+       (aset prefix1 (length prefix) char)
+       (substitute-key-definition-key defn olddef newdef prefix1 keymap))
+     scan)))
+
+(defun substitute-key-definition-key (defn olddef newdef prefix keymap)
+  (let (inner-def skipped menu-item)
+    ;; Find the actual command name within the binding.
+    (el:if (eq (car-safe defn) 'menu-item)
+       (setq menu-item defn defn (nth 2 defn))
+      ;; Skip past menu-prompt.
+      (while (stringp (car-safe defn))
+       (push (pop defn) skipped))
+      ;; Skip past cached key-equivalence data for menu items.
+      (if (consp (car-safe defn))
+         (setq defn (cdr defn))))
+    (el:if (or (eq defn olddef)
+           ;; Compare with equal if definition is a key sequence.
+           ;; That is useful for operating on function-key-map.
+           (and (or (stringp defn) (vectorp defn))
+                (equal defn olddef)))
+       (define-key keymap prefix
+         (if menu-item
+             (let ((copy (copy-sequence menu-item)))
+               (setcar (nthcdr 2 copy) newdef)
+               copy)
+           (nconc (nreverse skipped) newdef)))
+      ;; Look past a symbol that names a keymap.
+      (setq inner-def
+           (or (indirect-function defn t) defn))
+      ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
+      ;; avoid autoloading a keymap.  This is mostly done to preserve the
+      ;; original non-autoloading behavior of pre-map-keymap times.
+      (if (and (keymapp inner-def)
+              ;; Avoid recursively scanning
+              ;; where KEYMAP does not have a submap.
+              (let ((elt (lookup-key keymap prefix)))
+                (or (null elt) (natnump elt) (keymapp elt)))
+              ;; Avoid recursively rescanning keymap being scanned.
+              (not (memq inner-def key-substitution-in-progress)))
+         ;; If this one isn't being scanned already, scan it now.
+         (substitute-key-definition olddef newdef keymap inner-def prefix)))))
+
+
 (provide :lice-0.1/subr)
index 08769f8..6df120b 100644 (file)
@@ -49,7 +49,7 @@
                                 #+movitz (make-default-movitz-frame (get-buffer "*scratch*")))
              *selected-frame* (car *frame-list*)
              *process-list* nil)
-       (make-global-keymaps)
+       ;;(make-global-keymaps)
        (catch 'lice-quit 
          #+clisp
          (ext:with-keyboard
index 35ae865..401e2fc 100644 (file)
          ;; restore the last command
          (*last-command* *last-command*)
         (ret (catch 'exit
-               (with-lice-debugger
+               ;;(with-lice-debugger
                    (loop 
                       (frame-render (selected-frame))
-                      (top-level-next-event))))))
+                      (top-level-next-event)))))
     ;; return the ret val.
     (dformat +debug-v+ "ret ~a~%" ret)
     (when ret
index a4769f8..592f3e6 100644 (file)
@@ -54,6 +54,45 @@ STRING should be given if the last search was by `string-match' on STRING."
          (substring string (match-beginning num) (match-end num))
           (buffer-substring (match-beginning num) (match-end num)))))
 
+(defun replace-match (newtext &optional fixedcase literal string subexp)
+  "Replace text matched by last search with NEWTEXT.
+Leave point at the end of the replacement text.
+
+If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
+Otherwise maybe capitalize the whole text, or maybe just word initials,
+based on the replaced text.
+If the replaced text has only capital letters
+and has at least one multiletter word, convert NEWTEXT to all caps.
+Otherwise if all words are capitalized in the replaced text,
+capitalize each word in NEWTEXT.
+
+If third arg LITERAL is non-nil, insert NEWTEXT literally.
+Otherwise treat `\\' as special:
+  `\\&' in NEWTEXT means substitute original matched text.
+  `\\N' means substitute what matched the Nth `\\(...\\)'.
+       If Nth parens didn't match, substitute nothing.
+  `\\\\' means insert one `\\'.
+Case conversion does not apply to these substitutions.
+
+FIXEDCASE and LITERAL are optional arguments.
+
+The optional fourth argument STRING can be a string to modify.
+This is meaningful when the previous match was done against STRING,
+using `string-match'.  When used this way, `replace-match'
+creates and returns a new string made by copying STRING and replacing
+the part of STRING that was matched.
+
+The optional fifth argument SUBEXP specifies a subexpression;
+it says to replace just that subexpression with NEWTEXT,
+rather than replacing the entire matched text.
+This is, in a vague sense, the inverse of using `\\N' in NEWTEXT;
+`\\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts
+NEWTEXT in place of subexp N.
+This is useful only after a regular expression search or match,
+since only regular expressions have distinguished subexpressions."
+  (declare (ignore newtext fixedcase literal string subexp))
+  (error "unimplemented"))
+
 
 (defun match-string-no-properties (num &optional string)
   "Return string of text matched by last search, without text properties.
index 15c25e4..f60d6b8 100644 (file)
@@ -976,4 +976,21 @@ WINDOW defaults to the selected window.
 This is updated by redisplay or by calling `set-window-start'."
   (marker-position (window-top window)))
 
+\f
+;;; Key bindings
+(define-key *ctl-x-map* "1" 'delete-other-windows)
+(define-key *ctl-x-map* "2" 'split-window)
+(define-key *ctl-x-map* "0" 'delete-window)
+(define-key *ctl-x-map* "o" 'other-window)
+(define-key *ctl-x-map* "^" 'enlarge-window)
+(define-key *ctl-x-map* "<" 'scroll-left)
+(define-key *ctl-x-map* ">" 'scroll-right)
+
+(define-key *global-map* "C-v" 'scroll-up)
+(define-key *global-map* "M-C-v" 'scroll-other-window)
+(define-key *global-map* "M-v" 'scroll-down)
+
+(define-key *global-map* "C-l" 'recenter)
+(define-key *global-map* "M-r" 'move-to-window-line)
+
 (provide :lice-0.1/window)