From 37a0edaf7eca1a4719c4d415eb3f297d136370aa Mon Sep 17 00:00:00 2001 From: tailor Date: Mon, 7 May 2007 17:11:31 +0000 Subject: [PATCH] [lice @ some bug fixes, a makefile, autoconf support] --- Makefile.in | 19 +++++++++++++++++++ clisp-render.lisp | 19 ++++++++----------- configure.ac | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ doctor.lisp | 14 +++++++------- global.lisp | 4 ++-- keyboard.lisp | 40 ++++++++++++++++++++++------------------ keymap.lisp | 2 +- lice.asd | 11 ++++++----- make-image.lisp | 29 +++++++++++++++++++++++++++++ syntax.lisp | 9 +++++---- 10 files changed, 147 insertions(+), 48 deletions(-) create mode 100644 Makefile.in create mode 100644 configure.ac create mode 100644 make-image.lisp diff --git a/Makefile.in b/Makefile.in new file mode 100644 index 0000000..453f244 --- /dev/null +++ b/Makefile.in @@ -0,0 +1,19 @@ +# choose your lisp and appropriate lisp_opts +LISP=@LISP_PROGRAM@ + +clisp_OPTS=-K full -on-error exit -i ~/.clisprc ./make-image.lisp +sbcl_OPTS=--load ./make-image.lisp + +LISP_OPTS= $(@LISP@_OPTS) + +# This is copied from the .asd file. It'd be nice to have the list in +# one place, but oh well. +FILES=package.lisp wrappers.lisp global.lisp custom.lisp commands.lisp data-types.lisp keymap.lisp casefiddle.lisp subprocesses.lisp buffer-local.lisp buffer.lisp intervals.lisp textprop.lisp search.lisp frame.lisp window.lisp render.lisp wm.lisp insdel.lisp cmds.lisp editfns.lisp undo.lisp syntax.lisp major-mode.lisp keyboard.lisp debugger.lisp recursive-edit.lisp minibuffer.lisp files.lisp help.lisp debug.lisp tty-render.lisp clisp-render.lisp main.lisp subr.lisp simple.lisp indent.lisp lisp-mode.lisp lisp-indent.lisp paragraphs.lisp text-mode.lisp doctor.lisp + +all: lice + +lice: $(FILES) + $(LISP) $(LISP_OPTS) + +clean: + rm -f *.fasl *.fas *.lib lice diff --git a/clisp-render.lisp b/clisp-render.lisp index d7fcbb1..aaa1db5 100644 --- a/clisp-render.lisp +++ b/clisp-render.lisp @@ -131,7 +131,7 @@ the text properties present." (clear-to-eol i 0 w frame))))) ;; Update the mode-line if it exists. FIXME: Not the right place ;; to update the mode-line. - (when (buffer-mode-line (window-buffer w)) + (when (buffer-local '*mode-line-format* (window-buffer w)) (update-mode-line (window-buffer w)) (putstr (truncate-mode-line (window-buffer w) (window-width w)) 0 (window-height w nil) w frame) @@ -145,22 +145,19 @@ the text properties present." ;;; keyboard stuff (defmethod frame-read-event ((frame clisp-frame)) - (let* ((input (read-char EXT:*KEYBOARD-INPUT*));; (input (screen::read-keyboard-char (frame-window-stream frame))) - (ch (if (sys::input-character-char input) - (char-downcase (sys::input-character-char input)) - (char-downcase (sys::input-character-key input)))) - meta) + (let* ((input (read-char EXT:*KEYBOARD-INPUT*)) ;; (input (screen::read-keyboard-char (frame-window-stream frame))) + (ch (code-char (logand (char-code (or (ext:char-key input) (character input))) + (lognot 128)))) + (meta (= (logand (char-code (or (ext:char-key input) (character input))) 128) 128))) (when (and (characterp ch) (char= ch #\Escape)) (setf input (read-char EXT:*KEYBOARD-INPUT*) meta t)) (make-instance 'key - :char (if (sys::input-character-char input) - (char-downcase (sys::input-character-char input)) - (char-downcase (sys::input-character-key input))) - :control (sys::char-bit input :control) + :char ch + :control (ext:char-bit input :control) :meta (or meta - (sys::char-bit input :meta))))) + (ext:char-bit input :meta))))) ;;; some frame stuff diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..ece9585 --- /dev/null +++ b/configure.ac @@ -0,0 +1,48 @@ +# -*- Autoconf -*- +# Process this file with autoconf to produce a configure script. + +AC_PREREQ(2.59) +AC_INIT(Lisp Computing Environment, 0.0.0, sabetts@vcn.bc.ca) + +AC_SUBST(LISP_PROGRAM) +AC_SUBST(LISP) + +# Checks for programs. +AC_ARG_WITH(lisp, [ --with-lisp=IMPL use the specified lisp (either sbcl or clisp)], LISP=$withval, LISP="sbcl") +AC_ARG_WITH(sbcl, [ --with-sbcl=PATH specify full path to sbcl], SBCL_PATH=$withval, SBCL_PATH="") +AC_ARG_WITH(clisp, [ --with-clisp=PATH specify full path to clisp], CLISP_PATH=$withval, CLISP_PATH="") + +AC_PATH_PROG([CLISP], clisp,"",[$CLISP_PATH:$PATH]) +AC_PATH_PROG([SBCL], sbcl,"",[$SBCL_PATH:$PATH]) +AC_PATH_PROG([SBCL], sbcl,"",[$SBCL_PATH:$PATH]) + +if test "x$LISP" = "xclisp"; then + if test "x$CLISP" = "x"; then + LISP=sbcl + LISP_PROGRAM=$SBCL + else + LISP_PROGRAM=$CLISP + fi +elif test "x$LISP" = "xsbcl"; then + if test "x$SBCL" = "x"; then + LISP=clisp + LISP_PROGRAM=$CLISP + else + LISP_PROGRAM=$SBCL + fi +fi + +if test "x$LISP_PROGRAM" = "x"; then + AC_MSG_ERROR([*** No lisp is available.]) +fi + +AC_MSG_NOTICE([Using $LISP at $LISP_PROGRAM]) + +# Checks for libraries. + +# Checks for header files. + +# Checks for typedefs, structures, and compiler characteristics. + +# Checks for library functions. +AC_OUTPUT(Makefile) diff --git a/doctor.lisp b/doctor.lisp index be8b184..d9ee515 100644 --- a/doctor.lisp +++ b/doctor.lisp @@ -896,12 +896,12 @@ Otherwise call the Doctor to parse preceding sentence." (defcommand doctor-read-print () "top level loop" - (let ((sent (doctor-readin))) - (insert "\n") - (setq lincount (1+ lincount)) - (doctor-doc sent) - (insert "\n") - (setq bak sent))) + (setf sent (doctor-readin)) + (insert "\n") + (setq lincount (1+ lincount)) + (doctor-doc) + (insert "\n") + (setq bak sent)) (defun doctor-readin nil "Read a sentence. Return it as a list of words." @@ -924,7 +924,7 @@ Otherwise call the Doctor to parse preceding sentence." ;;(declaim (special sent)) -(defun doctor-doc (sent) +(defun doctor-doc () ;; Old emacs programs actually depended on dynamic scope! (cond ((equal sent '(foo)) diff --git a/global.lisp b/global.lisp index 7b3f8a8..804ef73 100644 --- a/global.lisp +++ b/global.lisp @@ -238,8 +238,8 @@ Modifies the match data; use `save-match-data' if necessary." (defun memoize-store (state thing value) (incf (memoize-state-pt state)) - (when (> (memoize-state-pt state) - (length (memoize-state-data state))) + (when (>= (memoize-state-pt state) + (length (memoize-state-data state))) (setf (memoize-state-pt state) 0)) (setf (svref (memoize-state-data state) (memoize-state-pt state)) (cons thing value)) value) diff --git a/keyboard.lisp b/keyboard.lisp index 607fbaa..f540aec 100644 --- a/keyboard.lisp +++ b/keyboard.lisp @@ -79,27 +79,30 @@ events that invoked the current command." ;; This is really TTY specific (defun next-event () (let* ((*current-event* (if *unread-command-events* - (pop *unread-command-events*) - (wait-for-event))) - (def (if *current-kmap* - (lookup-key *current-kmap* *current-event* t) - ;; no current kmap? - (or - (when *overriding-terminal-local-map* - (lookup-key-internal *overriding-terminal-local-map* *current-event* t *current-keymap-theme* t)) - (when *overriding-local-map* - (lookup-key-internal *overriding-local-map* *current-event* t *current-keymap-theme* t)) - (when (current-local-map) - (lookup-key-internal (current-local-map) *current-event* t *current-keymap-theme* 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))))) + (pop *unread-command-events*) + (wait-for-event))) + (def (if *current-kmap* + (lookup-key-internal *current-kmap* *current-event* t *current-keymap-theme* t) + ;; no current kmap? + (or + (when *overriding-terminal-local-map* + (lookup-key-internal *overriding-terminal-local-map* *current-event* t *current-keymap-theme* t)) + (when *overriding-local-map* + (lookup-key-internal *overriding-local-map* *current-event* t *current-keymap-theme* t)) + (when (current-local-map) + (lookup-key-internal (current-local-map) *current-event* t *current-keymap-theme* 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))))) (dformat +debug-v+ "~a ~s ~a~%" def #|(key-hashid *current-event*)|# *current-event* (key-char *current-event*)) (if def (handle-key-binding def *current-event*) - (message "~{~a ~}is undefined" (mapcar 'print-key (cons *current-event* (this-command-keys))))))) + (progn + (message "~{~a ~}is undefined" (mapcar 'print-key (reverse (cons *current-event* (this-command-keys))))) + (setf *this-command-keys* nil) + (throw :unbound-key nil))))) (defgeneric handle-key-binding (binding key-seq)) @@ -157,6 +160,7 @@ events that invoked the current command." ;; command is dispatched. Otherwise, calls to set-buffer ;; would stick. (setf *current-buffer* (window-buffer (frame-selected-window (selected-frame)))) - (next-event)) + (catch :unbound-key + (next-event))) (provide :lice-0.1/input) diff --git a/keymap.lisp b/keymap.lisp index f4a9690..3040ee0 100644 --- a/keymap.lisp +++ b/keymap.lisp @@ -23,7 +23,7 @@ (when (key-hyper key) "H-"))) (defun print-key (key) - (format nil "~a~a" (print-mods key) (or (char-name (key-char key)) (key-char key)))) + (format nil "~a~a" (print-mods key) (key-char key))) (defmethod print-object ((obj key) stream) (print-unreadable-object (obj stream :type t :identity t) diff --git a/lice.asd b/lice.asd index 1e18703..5c04e5e 100644 --- a/lice.asd +++ b/lice.asd @@ -5,7 +5,7 @@ (load "package.lisp") (defsystem :lice - :depends-on (cl-ncurses cl-ppcre) + :depends-on (#-clisp cl-ncurses cl-ppcre) :components ((:file "wrappers") (:file "global") (:file "custom") @@ -38,12 +38,13 @@ (:file "files" :depends-on ("buffer" "buffer-local" "commands" "custom")) (:file "help" :depends-on ("buffer" "commands")) (:file "debug" :depends-on ("buffer" "commands")) - (:file "tty-render" :depends-on ("buffer" "window" "frame" "render")) - (:file "main" :depends-on ("buffer" "major-mode" "tty-render")) + #+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" #+sbcl "tty-render" #+clisp "clisp-render")) ;; the following are files outside of lice-base (:file "subr" :depends-on ("commands" "buffer")) - (:file "simple" :depends-on ("subr" "commands" "keymap" "major-mode" "custom")) - (:file "indent" :depends-on ("subr" "simple")) + (:file "simple" :depends-on ("subr" "commands" "keymap" "major-mode" "custom" "editfns")) + (:file "indent" :depends-on ("subr" "simple" "editfns")) (:file "lisp-mode" :depends-on ("indent" "simple")) (:file "lisp-indent" :depends-on ("lisp-mode" "indent" "simple")) (:file "paragraphs" :depends-on ("simple")) diff --git a/make-image.lisp b/make-image.lisp new file mode 100644 index 0000000..54a7a71 --- /dev/null +++ b/make-image.lisp @@ -0,0 +1,29 @@ +;;; SBCL +#+sbcl +(progn + (require 'asdf) + (load "lice.asd") + (require 'lice)) +#+sbcl +(sb-ext:save-lisp-and-die "lice" :toplevel (lambda () + ;; asdf requires sbcl_home to be set, so set it to the value when the image was built + (sb-posix:putenv (format nil "SBCL_HOME=~A" #.(sb-ext:posix-getenv "SBCL_HOME"))) + (lice::lice) + 0) + :executable t) + +;;; CLISP + +;; asdf needs to be loaded. try putting (load "/path/to/asdf.lisp") in your .clisprc file +#+clisp +(asdf:oos 'asdf:load-op :lice) + +#+clisp +(progn + (ext:saveinitmem "lice" :init-function (lambda () + (lice::lice) + (ext:quit)) + :executable t :keep-global-handlers t :norc t :documentation "Lisp Computing Environment")) + + +#-(or sbcl clisp) (error "This lisp implementation is not supported.") diff --git a/syntax.lisp b/syntax.lisp index 83b9a7b..c4ed994 100644 --- a/syntax.lisp +++ b/syntax.lisp @@ -356,6 +356,7 @@ or after. On return global syntax data is good for lookup at CHAR-POS." quoted)) (defstruct parse-state + buffer depth min-depth this-level-start prev-level-start @@ -401,7 +402,7 @@ update the global data." ;; Return what we found (make-parse-state :start-value pt :start-value-aref pt-aref - :start-buffer buffer + :buffer buffer ;; :modiff MODIFF :start-begv (begv buffer) :start-pos pos))) @@ -957,8 +958,8 @@ If successful, return the charpos of the comment's beginning, and the aref pos. comment-start-aref ;; Place where the containing defun starts, ;; or nil if we didn't come across it yet. - defun-start - defun-start-aref + (defun-start 0) + (defun-start-aref 0) code (nesting 1) ; current comment nesting ch @@ -1072,7 +1073,7 @@ If successful, return the charpos of the comment's beginning, and the aref pos. comment-start-aref from-aref) (progn (decf nesting) - (when (<= nesting) + (when (<= nesting 0) ;; nested comments have to be balanced, so we don't need to ;; keep looking for earlier ones. We use here the same (slightly ;; incorrect) reasoning as below: since it is followed by uniform -- 2.11.4.GIT