[climacs-cvs] CVS update: climacs/pane.lisp climacs/packages.lisp climacs/gui.lisp
Dave Murray
dmurray at common-lisp.net
Fri Aug 19 09:12:50 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv14566
Modified Files:
pane.lisp packages.lisp gui.lisp
Log Message:
Added read-only buffers, com-find-file-read-only (C-x C-r),
com-toggle-read-only (C-x C-q) and "%%" display in mode line.
Date: Fri Aug 19 11:12:49 2005
Author: dmurray
Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.29 climacs/pane.lisp:1.30
--- climacs/pane.lisp:1.29 Tue Aug 16 01:31:22 2005
+++ climacs/pane.lisp Fri Aug 19 11:12:48 2005
@@ -176,6 +176,47 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
+;;; Readonly
+
+(defclass read-only-mixin ()
+ ((read-only-p :initform nil :accessor read-only-p)))
+
+(define-condition buffer-read-only (simple-error)
+ ((buffer :reader condition-buffer :initarg :buffer))
+ (:report (lambda (condition stream)
+ (format stream "Attempt to change read only buffer: ~a"
+ (condition-buffer condition))))
+ (:documentation "This condition is signalled whenever an attempt
+is made to alter a buffer which has been set read only."))
+
+(defmethod insert-buffer-object ((buffer read-only-mixin) offset object)
+ (if (read-only-p buffer)
+ (error 'buffer-read-only :buffer buffer)
+ (call-next-method)))
+
+(defmethod insert-buffer-sequence ((buffer read-only-mixin) offset sequence)
+ (if (read-only-p buffer)
+ (error 'buffer-read-only :buffer buffer)
+ (call-next-method)))
+
+(defmethod delete-buffer-range ((buffer read-only-mixin) offset n)
+ (if (read-only-p buffer)
+ (error 'buffer-read-only :buffer buffer)
+ (call-next-method)))
+
+(defmethod (setf buffer-object) (object (buffer read-only-mixin) offset)
+ (if (read-only-p buffer)
+ (error 'buffer-read-only :buffer buffer)
+ (call-next-method)))
+
+(defmethod read-only-p ((buffer delegating-buffer))
+ (read-only-p (implementation buffer)))
+
+(defmethod (setf read-only-p) (flag (buffer delegating-buffer))
+ (setf (read-only-p (implementation buffer)) flag))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
;;; View
(defclass climacs-textual-view (textual-view tabify-mixin)
@@ -186,10 +227,10 @@
;(defgeneric indent-tabs-mode (climacs-buffer))
-(defclass extended-standard-buffer (standard-buffer undo-mixin abbrev-mixin) ()
+(defclass extended-standard-buffer (read-only-mixin standard-buffer undo-mixin abbrev-mixin) ()
(:documentation "Extensions accessible via marks."))
-(defclass extended-binseq2-buffer (binseq2-buffer p-undo-mixin abbrev-mixin) ()
+(defclass extended-binseq2-buffer (read-only-mixin binseq2-buffer p-undo-mixin abbrev-mixin) ()
(:documentation "Extensions accessible via marks."))
(defclass climacs-buffer (delegating-buffer filepath-mixin name-mixin)
Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.78 climacs/packages.lisp:1.79
--- climacs/packages.lisp:1.78 Wed Aug 17 01:10:29 2005
+++ climacs/packages.lisp Fri Aug 19 11:12:48 2005
@@ -140,6 +140,7 @@
(:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev
:climacs-syntax :flexichain :undo)
(:export #:climacs-buffer #:needs-saving #:filepath
+ #:read-only-p #:buffer-read-only
#:climacs-pane #:point #:mark
#:redisplay-pane #:full-redisplay
#:display-cursor
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.179 climacs/gui.lisp:1.180
--- climacs/gui.lisp:1.179 Thu Aug 18 22:44:48 2005
+++ climacs/gui.lisp Fri Aug 19 11:12:48 2005
@@ -112,7 +112,9 @@
(top (top master-pane))
(bot (bot master-pane))
(name-info (format nil " ~a ~a~:[~30t~a~;~*~] ~:[(~;Syntax: ~]~a~a~a~a~:[)~;~] ~a"
- (if (needs-saving buf) "**" "--")
+ (cond ((needs-saving buf) "**")
+ ((read-only-p buf) "%%")
+ (t "--"))
(name buf)
*with-scrollbars*
(cond ((and (mark= size bot)
@@ -168,7 +170,9 @@
(no-expression ()
(beep) (display-message "No expression around point"))
(no-such-operation ()
- (beep) (display-message "Operation unavailable for syntax"))))
+ (beep) (display-message "Operation unavailable for syntax"))
+ (buffer-read-only ()
+ (beep) (display-message "Buffer is read only"))))
(defmethod execute-frame-command :after ((frame climacs) command)
(loop for buffer in (buffers frame)
@@ -656,31 +660,80 @@
(push buffer (buffers *application-frame*))
buffer))
+(defun find-file (filepath)
+ (cond ((directory-pathname-p filepath)
+ (display-message "~A is a directory name." filepath)
+ (beep))
+ (t
+ (let ((existing-buffer (find filepath (buffers *application-frame*)
+ :key #'filepath :test #'equal)))
+ (if existing-buffer
+ (switch-to-buffer existing-buffer)
+ (let ((buffer (make-buffer))
+ (pane (current-window)))
+ (setf (offset (point (buffer pane))) (offset (point pane)))
+ (setf (buffer (current-window)) buffer)
+ (setf (syntax buffer)
+ (make-instance (syntax-class-name-for-filepath filepath)
+ :buffer (buffer (point pane))))
+ ;; Don't want to create the file if it doesn't exist.
+ (when (probe-file filepath)
+ (with-open-file (stream filepath :direction :input)
+ (input-from-stream stream buffer 0)))
+ (setf (filepath buffer) filepath
+ (name buffer) (filepath-filename filepath)
+ (needs-saving buffer) nil)
+ (beginning-of-buffer (point pane))
+ ;; this one is needed so that the buffer modification protocol
+ ;; resets the low and high marks after redisplay
+ (redisplay-frame-panes *application-frame*)
+ buffer))))))
+
(define-named-command com-find-file ()
(let ((filepath (accept 'completable-pathname
:prompt "Find File")))
- (cond ((directory-pathname-p filepath)
- (display-message "~A is a directory name." filepath)
- (beep))
- (t
- (let ((buffer (make-buffer))
- (pane (current-window)))
- (setf (offset (point (buffer pane))) (offset (point pane)))
- (setf (buffer (current-window)) buffer)
- (setf (syntax buffer)
- (make-instance (syntax-class-name-for-filepath filepath)
- :buffer (buffer (point pane))))
- ;; Don't want to create the file if it doesn't exist.
- (when (probe-file filepath)
- (with-open-file (stream filepath :direction :input)
- (input-from-stream stream buffer 0)))
- (setf (filepath buffer) filepath
- (name buffer) (filepath-filename filepath)
- (needs-saving buffer) nil)
- (beginning-of-buffer (point pane))
- ;; this one is needed so that the buffer modification protocol
- ;; resets the low and high marks after redisplay
- (redisplay-frame-panes *application-frame*))))))
+ (find-file filepath)))
+
+(defun find-file-read-only (filepath)
+ (cond ((directory-pathname-p filepath)
+ (display-message "~A is a directory name." filepath)
+ (beep))
+ (t
+ (let ((existing-buffer (find filepath (buffers *application-frame*)
+ :key #'filepath :test #'equal)))
+ (if (and existing-buffer (read-only-p existing-buffer))
+ (switch-to-buffer existing-buffer)
+ (if (probe-file filepath)
+ (let ((buffer (make-buffer))
+ (pane (current-window)))
+ (setf (offset (point (buffer pane))) (offset (point pane)))
+ (setf (buffer (current-window)) buffer)
+ (setf (syntax buffer)
+ (make-instance (syntax-class-name-for-filepath filepath)
+ :buffer (buffer (point pane))))
+ (with-open-file (stream filepath :direction :input)
+ (input-from-stream stream buffer 0))
+ (setf (filepath buffer) filepath
+ (name buffer) (filepath-filename filepath)
+ (needs-saving buffer) nil
+ (read-only-p buffer) t)
+ (beginning-of-buffer (point pane))
+ ;; this one is needed so that the buffer modification protocol
+ ;; resets the low and high marks after redisplay
+ (redisplay-frame-panes *application-frame*)
+ buffer)
+ (progn
+ (display-message "No such file: ~A" filepath)
+ (beep)
+ nil)))))))
+
+(define-named-command com-find-file-read-only ()
+ (let ((filepath (accept 'completable-pathname :Prompt "Find file read only")))
+ (find-file-read-only filepath)))
+
+(define-named-command com-toggle-read-only ()
+ (let ((buffer (buffer (current-window))))
+ (setf (read-only-p buffer) (not (read-only-p buffer)))))
(defun set-visited-file-name (filename buffer)
(setf (filepath buffer) filename
@@ -825,7 +878,8 @@
(push buffer (buffers *application-frame*)))
(setf (offset (point (buffer pane))) (offset (point pane)))
(setf (buffer pane) buffer)
- (full-redisplay pane)))
+ (full-redisplay pane)
+ buffer))
(defmethod switch-to-buffer ((name string))
(let ((buffer (find name (buffers *application-frame*)
@@ -1977,6 +2031,8 @@
(c-x-set-key '(#\3) 'com-split-window-horizontally)
(c-x-set-key '(#\b) 'com-switch-to-buffer)
(c-x-set-key '(#\f :control) 'com-find-file)
+(c-x-set-key '(#\r :control) 'com-find-file-read-only)
+(c-x-set-key '(#\q :control) 'com-toggle-read-only)
(c-x-set-key '(#\f) `(com-set-fill-column ,*numeric-argument-marker*))
(c-x-set-key '(#\h) 'com-mark-whole-buffer)
(c-x-set-key '(#\i) 'com-insert-file)
More information about the Climacs-cvs
mailing list