[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp climacs/buffer.text climacs/syntax.text climacs/undo.text

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv29346

Modified Files:
	gui.lisp packages.lisp syntax.lisp 
Removed Files:
	buffer.text syntax.text undo.text 
Log Message:
Resolved conflict in gui.lisp.


Date: Sat Dec 25 13:29:24 2004
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.13 climacs/gui.lisp:1.14
--- climacs/gui.lisp:1.13	Sat Dec 25 00:17:48 2004
+++ climacs/gui.lisp	Sat Dec 25 13:29:24 2004
@@ -40,7 +40,7 @@
      (when (null point)
        (setf point (make-instance 'standard-right-sticky-mark
 		      :buffer buffer)))
-     (setf syntax (make-instance 'basic-syntax :buffer buffer :pane pane))))
+     (setf syntax (make-instance 'texinfo-syntax :buffer buffer :pane pane))))
 
 (define-application-frame climacs ()
   ((win :reader win))
@@ -246,10 +246,11 @@
     (with-slots (buffer point syntax) (win *application-frame*)
        (setf buffer (make-instance 'climacs-buffer)
 	     point (make-instance 'standard-right-sticky-mark :buffer buffer)
-	     syntax (make-instance 'basic-syntax :buffer buffer :pane (win *application-frame*))
+	     syntax (make-instance 'texinfo-syntax :buffer buffer :pane (win *application-frame*))
 	     (filename buffer) filename)
        (with-open-file (stream filename :direction :input)
-	 (input-from-stream stream buffer 0)))))
+	 (input-from-stream stream buffer 0))
+       (beginning-of-buffer point))))
 
 (define-command com-save-buffer ()
   (let ((filename (or (filename (buffer (win *application-frame*)))
@@ -259,6 +260,15 @@
     (with-open-file (stream filename :direction :output :if-exists :supersede)
       (output-to-stream stream buffer 0 (size buffer)))))
 
+(define-command com-beginning-of-buffer ()
+  (beginning-of-buffer (point (win *application-frame*))))
+
+(define-command com-end-of-buffer ()
+  (end-of-buffer (point (win *application-frame*))))
+
+(define-command com-browse-url ()
+  (accept 'url :prompt "Browse URL"))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Global command table
@@ -288,6 +298,9 @@
 (global-set-key '(#\x :meta) 'com-extended-command)
 (global-set-key '(#\a :meta) 'com-insert-weird-stuff)
 (global-set-key '(#\c :meta) 'com-insert-reversed-string)
+(global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer)
+(global-set-key '(#\> :shift :meta) 'com-end-of-buffer)
+(global-set-key '(#\u :meta) 'com-browse-url)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
@@ -299,12 +312,15 @@
 				:menu 'c-x-climacs-table
 				:keystroke '(#\x :control))
 
-;;; for some reason, C-c does not seem to arrive as far as CLIM.
+(defun c-x-set-key (gesture command)
+  (add-command-to-command-table command 'c-x-climacs-table
+				:keystroke gesture :errorp nil))
 
 (defun c-x-set-key (gesture command)
   (add-command-to-command-table command 'c-x-climacs-table
 				:keystroke gesture :errorp nil))
 
+;;; for some reason, C-c does not seem to arrive as far as CLIM.
 (c-x-set-key '(#\q :control) 'com-quit)
 (c-x-set-key '(#\f :control) 'com-find-file)
-(c-x-set-key '(#\s :control) 'com-save-buffer)
\ No newline at end of file
+(c-x-set-key '(#\s :control) 'com-save-buffer)


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.8 climacs/packages.lisp:1.9
--- climacs/packages.lisp:1.8	Thu Dec 23 19:49:32 2004
+++ climacs/packages.lisp	Sat Dec 25 13:29:24 2004
@@ -55,8 +55,9 @@
 
 (defpackage :climacs-syntax
   (:use :clim-lisp :clim :climacs-buffer :climacs-base)
-  (:export #:syntax #:basic-syntax
-	   #:redisplay-with-syntax #:full-redisplay))
+  (:export #:syntax #:basic-syntax #:texinfo-syntax
+	   #:redisplay-with-syntax #:full-redisplay
+	   #:url))
 
 (defpackage :climacs-gui
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax))


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.2 climacs/syntax.lisp:1.3
--- climacs/syntax.lisp:1.2	Fri Dec 24 09:21:34 2004
+++ climacs/syntax.lisp	Sat Dec 25 13:29:24 2004
@@ -51,15 +51,21 @@
        (setf space-width (text-style-width style medium)
 	     tab-width (* 8 space-width)))))
 
-(defun present-contents (pane syntax)
+(define-presentation-type url ()
+  :inherit-from 'string)
+
+(defmethod present-contents (pane (syntax basic-syntax))
   (with-slots (saved-offset scan) syntax
      (unless (null saved-offset)
-       (present (coerce (region-to-sequence saved-offset scan) 'string)
-		'string
-		:stream pane)
+       (let ((word (coerce (region-to-sequence saved-offset scan) 'string)))
+	 (present word
+		  (if (and (>= (length word) 7) (string= (subseq word 0 7) "http://"))
+		      'url
+		      'string)
+		:stream pane))
        (setf saved-offset nil))))
 
-(defun display-line (pane syntax)
+(defmethod display-line (pane (syntax basic-syntax))
   (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax
      (loop when (mark= scan (point pane))
 	     do (multiple-value-bind (x y) (stream-cursor-position pane)
@@ -129,3 +135,23 @@
 		       cursor-x (- cursor-y (* 0.2 height))
 		       cursor-x (+ cursor-y (* 0.8 height))
 		       :ink +red+))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Texinfo syntax
+
+(defclass texinfo-syntax (basic-syntax) ())
+
+(define-presentation-type texinfo-command ()
+  :inherit-from 'string)
+
+(defmethod present-contents (pane (syntax texinfo-syntax))
+  (with-slots (saved-offset scan) syntax
+     (unless (null saved-offset)
+       (let ((word (coerce (region-to-sequence saved-offset scan) 'string)))
+	 (if (char= (aref word 0) #\@)
+	     (with-drawing-options (pane :ink +red+)
+	       (present word 'texinfo-command :stream pane))
+	     (present word 'string :stream pane)))
+       (setf saved-offset nil))))
+