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@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