Commit ca18e9ff authored by strandh's avatar strandh
Browse files

Added new file io.lisp with input/output functions and the

packages.lisp file accordingly.

Added README file.

Totally rewrote the buffer implementation to use a single flexichain.
It should now be fast enough to replace Goatee.

Modified climacs.asd to reflect the use of Flexichain

Updated INSTALL file to give instructions for fetching Flexichain.

Updated gui.lisp to reflect the new functionality in io.lisp
parent e484b3d3
Install instructions for Climacs. We assume that if you have gotten
this far, it means that you have either extracted a tar file with
everything in it, or checked out the files from some CVS repository.
If your directory contains a Flexichain subdirectory, skip directly to
paragraph 1 below. Otherwise start at paragraph 0.
0. You need to check out the Flexichain module from the Gsharp project
on If you are a member of that project, you can
do this:
export CVS_RSH=ssh
cvs -z3 -d :ext:<username> co Flexichain
If you are not a member, here is how you do it:
cvs -d login
<enter anonymous as password>
cvs -z3 -d co Flexichain
1. Start Lisp either from the shell or from Emacs
2. (load "climacs.asd")
Welcome to Climacs, a project to create a Common Lisp version of
Emacs. In fact, this project is merely meant to replace the buffer
protocols of Goatee (the editor of McCLIM) and Portable Hemlock, in an
attempt to ultimately merge those two projects.
Climacs contributes (or will contribute) a few important things that
are not found neither in Goatee nor in Portable Hemlock:
* A buffer protocol with a potentially very efficient
implementation based on flexichains;
* An `undo' protocol that is both general and powerful and that
works on top of the buffer protocol;
* An implementation of the association between multi-keystroke
gestures and commands using nested CLIM command tables;
* The possibility of having the buffer contain arbitrary
objects. These will be rendered by the CLIM `present' function,
so that they become clickable in the right context;
* Syntax highlighting in the form of incremental parsers, especially
for Common Lisp code.
How to contribute
[fill this in when we have a project]
What to work on
Climacs is a full CLIM application, and should take advantage of CLIM
as much as possible, in particular for completion, presentations, etc.
It is hard to resist the temptation to re-implement functionality that
is currently in Emacs but that really belongs either in CLIM or in
separate CLIM applications. In particular, we are NOT interested in:
* Mail and News readers (see mel and Hermes)
* A debugger (see the debugger pane of McCLIM)
* An inspector (see the inspector pane of McCLIM)
* Dired, Bufed, Shell mode, Calendar and other functionality that
is best done as a CLIM pane or a separate CLIM application
We ARE however interested in the following items:
* A grammar checker based on an incremental parser for natural
* Incremental parsers for programming languages other than Common
* A kill ring (perhaps the one from Portable Hemlock will do)
* Indentation warnings for Common Lisp
To install Climacs, se the INSTALL file.
......@@ -18,7 +18,7 @@
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
;;; A stupid implementation of the buffer protocol. This
;;; A not-so-stupid implementation of the buffer protocol. This
;;; implementation serves two purposes: First, so that higher-level
;;; functionality can be built on top of a working implementation of
;;; the buffer protocol, and second, to use as a comparison for
......@@ -29,8 +29,7 @@
(defclass buffer () ())
(defclass standard-buffer (buffer)
((contents :initform (list nil) :initarg :contents)
(marks :initform '())))
((contents :initform (make-instance 'standard-cursorchain))))
(defgeneric buffer (mark))
......@@ -45,20 +44,34 @@
(defclass mark-mixin ()
((buffer :initarg :buffer :reader buffer)
(offset :initarg :offset :initform 0 :accessor offset)))
(cursor :reader cursor)))
(defmethod (setf offset) :before (new-offset (mark mark-mixin))
(assert (<= 0 new-offset (size (buffer mark))) ()
(make-condition 'no-such-offset :offset new-offset)))
(defmethod offset (mark)
(cursor-pos (cursor mark)))
(defmethod initialize-instance :after ((mark mark-mixin) &rest args)
(declare (ignore args))
(push mark (slot-value (buffer mark) 'marks)))
(defmethod (setf offset) (new-offset mark)
(assert (<= 0 new-offset (size (buffer mark))) ()
(make-condition 'no-such-offset :offset new-offset))
(setf (cursor-pos (cursor mark)) new-offset))
(defclass standard-left-sticky-mark (left-sticky-mark mark-mixin) ())
(defclass standard-right-sticky-mark (right-sticky-mark mark-mixin) ())
(defmethod initialize-instance :after ((mark left-sticky-mark) &rest args &key (offset 0))
(declare (ignore args))
(setf (slot-value mark 'cursor)
(make-instance 'left-sticky-flexicursor
:chain (slot-value (buffer mark) 'contents)
:position offset)))
(defmethod initialize-instance :after ((mark right-sticky-mark) &rest args &key (offset 0))
(declare (ignore args))
(setf (slot-value mark 'cursor)
(make-instance 'right-sticky-flexicursor
:chain (slot-value (buffer mark) 'contents)
:position offset)))
(defgeneric clone-mark (mark &optional type))
(defmethod clone-mark ((mark standard-left-sticky-mark) &optional type)
......@@ -79,13 +92,13 @@
(defgeneric size (buffer))
(defmethod size ((buffer standard-buffer))
(1- (length (slot-value buffer 'contents))))
(nb-elements (slot-value buffer 'contents)))
(defgeneric number-of-lines (buffer))
(defmethod number-of-lines ((buffer standard-buffer))
(count #\Newline (cdr (slot-value buffer 'contents))))
(loop for offset from 0 below (size buffer)
count (eql (buffer-object buffer offset) #\Newline)))
(defgeneric mark< (mark1 mark2))
......@@ -147,7 +160,6 @@
(defmethod mark>= ((mark1 integer) (mark2 mark-mixin))
(>= mark1 (offset mark2)))
(defgeneric beginning-of-buffer (mark))
(defmethod beginning-of-buffer ((mark mark-mixin))
......@@ -197,8 +209,10 @@
(defgeneric line-number (mark))
(defmethod line-number ((mark mark-mixin))
(count #\Newline (cdr (slot-value (buffer mark) 'contents))
:end (offset mark)))
(loop with buffer = (buffer mark)
with end = (offset mark)
for offset from 0 below end
count (eql (buffer-object buffer offset) #\Newline)))
(defgeneric column-number (mark))
......@@ -213,12 +227,7 @@
(defmethod insert-buffer-object ((buffer standard-buffer) offset object)
(assert (<= 0 offset (size buffer)) ()
(make-condition 'no-such-offset :offset offset))
(push object (cdr (nthcdr offset (slot-value buffer 'contents))))
(loop for mark in (slot-value buffer 'marks)
when (or (> (offset mark) offset)
(and (= (offset mark) offset)
(typep mark 'right-sticky-mark)))
do (incf (offset mark))))
(insert* (slot-value buffer 'contents) offset object))
(defgeneric insert-buffer-sequence (buffer offset sequence))
......@@ -242,11 +251,8 @@
(defmethod delete-buffer-range ((buffer standard-buffer) offset n)
(assert (<= 0 offset (size buffer)) ()
(make-condition 'no-such-offset :offset offset))
(with-slots (contents marks) buffer
(setf (cdr (nthcdr offset contents)) (nthcdr (+ offset n 1) contents))
(loop for mark in marks
when (> (offset mark) offset)
do (setf (offset mark) (max offset (- (offset mark) n))))))
(loop repeat n
do (delete* (slot-value buffer 'contents) offset)))
(defgeneric delete-range (mark &optional n))
......@@ -281,7 +287,7 @@
(defmethod buffer-object ((buffer standard-buffer) offset)
(assert (<= 0 offset (1- (size buffer))) ()
(make-condition 'no-such-offset :offset offset))
(nth (1+ offset) (slot-value buffer 'contents)))
(element* (slot-value buffer 'contents) offset))
(defgeneric buffer-sequence (buffer offset1 offset2))
......@@ -290,7 +296,9 @@
(make-condition 'no-such-offset :offset offset1))
(assert (<= 0 offset2 (size buffer)) ()
(make-condition 'no-such-offset :offset offset2))
(coerce (subseq (slot-value buffer 'contents) (1+ offset1) (1+ offset2)) 'vector))
(coerce (loop for offset from offset1 below offset2
collect (buffer-object buffer offset))
(defgeneric object-before (mark))
......@@ -43,8 +43,15 @@
collect `(:file ,(pathname-name p) :pathname ,p))))))
(climacs-defsystem (:climacs)
......@@ -121,7 +121,8 @@
(loop with gestures = '()
do (setf *current-gesture* (read-gesture :stream *standard-input*))
(when (or (characterp *current-gesture*)
(keyboard-event-character *current-gesture*))
(and (typep *current-gesture* 'keyboard-event)
(keyboard-event-character *current-gesture*)))
(setf gestures (nconc gestures (list *current-gesture*)))
(let ((item (find-gestures gestures 'global-climacs-table)))
(cond ((not item)
......@@ -271,17 +272,13 @@
(define-command com-find-file ()
(let ((filename (handler-case (accept 'completable-pathname
:prompt "Find File")
(simple-parse-error () (error 'file-not-found)))))
(setf (buffer *application-frame*)
(make-instance 'abbrev-buffer
:contents (cons nil
(with-open-file (stream filename :direction :input)
(loop for ch = (read-char stream nil nil)
while ch
collect ch)))))
(simple-parse-error () (error 'file-not-found))))
(buffer (make-instance 'abbrev-buffer)))
(setf (buffer *application-frame*) buffer)
(with-open-file (stream filename :direction :input)
(input-from-stream stream buffer 0))
(setf (slot-value *application-frame* 'point)
(make-instance 'standard-right-sticky-mark
:buffer (buffer *application-frame*)))))
(make-instance 'standard-right-sticky-mark :buffer buffer))))
;;; -*- Mode: Lisp; Package: CLIMACS-BUFFER -*-
;;; (c) copyright 2004 by
;;; Robert Strandh (
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; Library General Public License for more details.
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
;;; Input/Output of buffers to and from streams.
(in-package :climacs-base)
(defun input-from-stream (stream buffer offset)
(let ((eof-object (cons nil nil)))
(loop for obj = (read-char stream nil eof-object)
until (eq obj eof-object)
do (insert-buffer-object buffer offset obj)
(incf offset))))
(defun output-to-stream (stream buffer offset1 offset2)
(loop for offset from offset1 below offset2
when (characterp (buffer-object buffer offset))
do (write-char (buffer-object buffer offset) stream)))
......@@ -21,7 +21,7 @@
;;; Package definitions for the Climacs editor.
(defpackage :climacs-buffer
(:use :clim-lisp)
(:use :clim-lisp :flexichain)
(:export #:buffer #:standard-buffer
#:mark #:left-sticky-mark #:right-sticky-mark
#:standard-left-sticky-mark #:standard-right-sticky-mark
......@@ -44,7 +44,8 @@
(:export #:previous-line #:next-line
#:open-line #:kill-line
#:forward-word #:backward-word))
#:forward-word #:backward-word
#:input-from-stream #:output-to-stream))
(defpackage :climacs-abbrev
(:use :clim-lisp :clim :climacs-buffer :climacs-base)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment