[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Fri Nov 16 09:29:47 UTC 2007
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv31589
Modified Files:
climacs.asd groups.lisp gui.lisp misc-commands.lisp
packages.lisp
Log Message:
Restored Climacs' Group-support.
--- /project/climacs/cvsroot/climacs/climacs.asd 2007/05/01 17:09:52 1.60
+++ /project/climacs/cvsroot/climacs/climacs.asd 2007/11/16 09:29:47 1.61
@@ -39,7 +39,7 @@
(:file "prolog-syntax" :depends-on ("packages"))
(:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
(:file "ttcn3-syntax" :depends-on ("packages"))
- (:file "climacs-lisp-syntax" :depends-on ("core" #+nil groups))
+ (:file "climacs-lisp-syntax" :depends-on ("core" "groups"))
(:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands"))
(:file "c-syntax" :depends-on ("core"))
(:file "c-syntax-commands" :depends-on ("c-syntax" "misc-commands"))
@@ -48,7 +48,7 @@
(:file "gui" :depends-on ("packages" "text-syntax"))
(:file "core" :depends-on ("gui"))
(:file "io" :depends-on ("packages" "gui"))
- #+nil (:file "groups" :depends-on ("core"))
+ (:file "groups" :depends-on ("core"))
(:file "climacs" :depends-on ("gui" "core"))
(:file "developer-commands" :depends-on ("core"))
--- /project/climacs/cvsroot/climacs/groups.lisp 2006/11/12 16:06:06 1.4
+++ /project/climacs/cvsroot/climacs/groups.lisp 2007/11/16 09:29:47 1.5
@@ -1,6 +1,6 @@
;;; -*- Mode: Lisp; Package: CLIMACS-CORE -*-
-;;; (c) copyright 2006 by
+;;; (c) copyright 2006-2007 by
;;; Troels Henriksen (athas at sigkill.dk)
;;; This library is free software; you can redistribute it and/or
@@ -24,9 +24,9 @@
(defvar *persistent-groups* (make-hash-table :test #'equal)
"A hash table of groups that are persistent across invocations
- of the Climacs editor. Typically, these do not designate
- concrete pathnames, but contain more abstract designations such
- as \"all files in the current directory\".")
+of the Climacs editor. Typically, these do not designate concrete
+pathnames, but contain more abstract designations such as \"all
+files in the current directory\".")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -46,7 +46,7 @@
(defclass current-buffer-group (group)
()
(:documentation "Group class denoting the currently active
- buffer."))
+buffer."))
(defclass synonym-group (group)
((%other-name :initarg :other-name
@@ -69,7 +69,7 @@
:initform nil
:accessor value-plist))
(:documentation "A group that will call a provided function
- when it is selected or asked for pathnames."))
+when it is selected or asked for pathnames."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -77,8 +77,8 @@
(defgeneric group-buffers (group)
(:documentation "Get a list of buffers in `group'. Only already
- existing buffers will be returned, use `ensure-group-buffers'
- if you want all buffers defined by the group."))
+existing buffers will be returned, use `ensure-group-buffers' if
+you want all buffers defined by the group."))
(defgeneric ensure-group-buffers (group)
(:documentation "For each pathname in `group' that does not
@@ -86,10 +86,10 @@
(defgeneric select-group (group)
(:documentation "Tell the group object `group' that the user
- has selected it. This method is responsible for setting the
- active group. If `group' needs additional information, it
- should query the user when this method is invoked. The standard
- method should be sufficient for most group classes.")
+has selected it. This method is responsible for setting the
+active group. If `group' needs additional information, it should
+query the user when this method is invoked. The standard method
+should be sufficient for most group classes.")
(:method ((group group))
;; Use a synonym group so that changes to the group of this name
;; will be reflected in the active group.
@@ -98,10 +98,10 @@
(defgeneric display-group-contents (group stream)
(:documentation "Display the contents of `group' to
- `stream'. Basically, this should describe which buffers or
- files would be affected by group-aware commands if `group' was
- the active group. There is no standard format for the output,
- but it is intended for displaying to the user."))
+`stream'. Basically, this should describe which buffers or files
+would be affected by group-aware commands if `group' was the
+active group. There is no standard format for the output, but it
+is intended for displaying to the user."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -375,3 +375,14 @@
(if (get-group (other-name object))
(present (get-group (other-name object)) type :stream stream :view view)
(error 'group-not-found :group-name (other-name object))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Now hook it all up.
+
+(setf *climacs-target-creator*
+ #'(lambda (drei)
+ (ensure-group-buffers (get-active-group))
+ (make-instance 'buffer-list-target-specification
+ :buffers (group-buffers (get-active-group))
+ :drei-instance drei)))
--- /project/climacs/cvsroot/climacs/gui.lisp 2007/11/16 09:25:03 1.237
+++ /project/climacs/cvsroot/climacs/gui.lisp 2007/11/16 09:29:47 1.238
@@ -40,6 +40,10 @@
of all panes. If NIL, don't. This is off by default, as finding
the line and column numbers is potentially expensive.")
+(defvar *climacs-target-creator* nil
+ "A function for creating targets for commands potentially
+acting over multiple buffers.")
+
(defclass climacs-buffer (drei-buffer)
((%external-format :initform *default-external-format*
:accessor external-format
@@ -223,7 +227,8 @@
(*current-mark* (current-mark))
(*previous-command* (previous-command *current-window*))
(*current-syntax* (and *current-buffer*
- (syntax *current-buffer*)))))
+ (syntax *current-buffer*)))
+ (*default-target-creator* *climacs-target-creator*)))
(defmethod frame-standard-input ((frame climacs))
(get-frame-pane frame 'minibuffer))
--- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/11/12 16:06:06 1.26
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2007/11/16 09:29:47 1.27
@@ -82,7 +82,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Groups
-#|| ;; FIXME: Commented about because of lack of support in DREI.
+
(define-command (com-define-group :name t :command-table global-climacs-table)
((name 'string :prompt "Name")
(buffers '(sequence drei-buffer) :prompt "Buffers"))
@@ -143,4 +143,3 @@
(set-key 'com-list-group-contents
'global-climacs-table
'((#\x :control) (#\g) (#\l)))
-||#
\ No newline at end of file
--- /project/climacs/cvsroot/climacs/packages.lisp 2007/06/04 21:52:06 1.125
+++ /project/climacs/cvsroot/climacs/packages.lisp 2007/11/16 09:29:47 1.126
@@ -29,7 +29,7 @@
(defpackage :climacs-gui
(:use :clim-lisp :clim :drei-buffer :drei-base
:drei-abbrev :drei-syntax :drei-motion
- :drei-kill-ring :drei :clim-extensions
+ :drei-kill-ring :drei-core :drei :clim-extensions
:drei-undo :esa :drei-editing :drei-motion
:esa-buffer :esa-io :esa-utils)
;;(:import-from :lisp-string)
@@ -65,12 +65,13 @@
#:*mini-fg-color*
#:*with-scrollbars*
#:*default-external-format*
+ #:*climacs-target-creator*
;; The command tables
#:global-climacs-table #:keyboard-macro-table #:climacs-help-table
#:base-table #:buffer-table #:case-table
- #:development-table
- #:info-table #:pane-table
+ #:development-table
+ #:info-table #:pane-table
#:window-table))
(defpackage :climacs-core
More information about the Climacs-cvs
mailing list