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)))) +