• R/O
  • SSH

cl-sack: Commit

CL-Sack is a Common Lisp library for making and manipulating Sack files.


Commit MetaInfo

Revision96b76fca0810eb7b518730ba6468c1759332b9fd (tree)
Zeit2019-02-12 16:51:02
AutorAlexa Jones-Gonzales <alexa@part...>
CommiterAlexa Jones-Gonzales

Log Message

Added ability to add entries and rename them.

Ändern Zusammenfassung

Diff

diff -r c9f6ddba5fab -r 96b76fca0810 gsacked-src/gui-main-window.lisp
--- a/gsacked-src/gui-main-window.lisp Fri Feb 08 16:45:39 2019 -0700
+++ b/gsacked-src/gui-main-window.lisp Tue Feb 12 00:51:02 2019 -0700
@@ -34,21 +34,37 @@
3434
3535 (define-application-frame main-window ()
3636 ((loaded-sack
37- :initform nil
38- :type (or null cl-sack:sack-file)
37+ :initform (cl-sack:make-sack-file)
38+ :type cl-sack:sack-file
3939 :accessor loaded-sack)
4040
4141 (needs-saving-p
4242 :initform t
4343 :type boolean
44- :accessor needs-saving-p))
44+ :accessor needs-saving-p)
45+
46+ (selected-entry
47+ :initform nil
48+ :type (or null cl-sack:sack-entry)
49+ :accessor selected-entry)
50+
51+ (data-pane
52+ :initform nil
53+ :reader data-pane)
54+
55+ (interaction-pane
56+ :initform nil
57+ :reader interactor))
4558
4659 (:panes
47- (entry-list clim-stream-pane
48- :display-time t
49- :scroll-bars t)
50- (data-view clim-stream-pane)
51- (int :interactor :height 200 :width *main-window-min-width*)
60+ (int :interactor)
61+ (entry-list :application
62+ :incremental-redisplay t
63+ :display-function 'display-entry-list)
64+ (data-view :application
65+ :incremental-redisplay t
66+ :display-function 'display-entry-data)
67+
5268 (pdoc :pointer-documentation))
5369
5470 (:menu-bar menu/main-window)
@@ -59,22 +75,85 @@
5975 (+fill+
6076 (horizontally ()
6177 (1/4 (labelling (:label "Entries")
62- (scrolling ()
63- entry-list)))
78+ entry-list))
6479 (+fill+ (labelling (:label "Data View")
65- (scrolling ()
66- data-view)))))
67- int
80+ data-view))))
81+
82+ (1/4 int)
83+
6884 pdoc))))
6985
86+(defmethod initialize-instance :after ((obj main-window) &key)
87+ (setf (slot-value obj 'interaction-pane) (find-pane-named obj 'int))
88+ (setf (slot-value obj 'data-pane) (find-pane-named obj 'data-view)))
7089
71-(define-main-window-command (com/about :name (format nil "About ~a" *program-long-name*))
90+;;;
91+;;; Entry Commands
92+;;;
93+
94+(define-main-window-command (com/select-entry :name nil) ((ent cl-sack:sack-entry :gesture :select))
95+ (setf (selected-entry *main-window*) ent))
96+
97+(define-main-window-command (com/new-entry :name "New Entry" :keystroke (#\n :control))
7298 ()
73- (format (frame-standard-output *main-window*) "Not yet implemented~%"))
99+ (let ((new-name "")
100+ (new-type :data)
101+ (stream (frame-standard-input *main-window*)))
102+ (window-clear stream)
103+ (accepting-values (stream :own-window t)
104+ (setf new-name (accept 'string :stream stream :prompt "Name"))
105+ (terpri stream)
106+ (setf new-type (accept '(member-alist (("Generic Data" . :data) ("Embedded Sack" . :sack)))
107+ :view climi::+pop-up-menu-view+
108+ :default :data
109+ :stream stream :prompt "Type"))
110+ (terpri stream))
74111
75-(define-main-window-command (com/new :name "New Sack" :keystroke (#\n :control))
112+ (cl-sack:add-entry (loaded-sack *main-window*)
113+ (cl-sack:make-sack-entry new-name :type (case new-type
114+ (:data cl-sack:+entry-type-data+)
115+ (:sack cl-sack:+entry-type-sack+))))
116+ (format stream "Added new ~a entry named ~s~%" new-type new-name)))
117+
118+;;;
119+;;; Entry List and Data View
120+;;;
121+
122+(defmethod display-entry-data ((frame main-window) stream)
123+ (let ((ent (selected-entry frame)))
124+ (when ent
125+ (updating-output (stream :unique-id ent)
126+ (with-text-face (stream :italic)
127+ (write-string "Name: " stream))
128+ (with-output-as-presentation (stream ent 'sack-entry-name)
129+ (write-string (cl-sack:name ent) stream))))))
130+
131+(defmethod display-entry-list ((frame main-window) stream)
132+ (cl-sack:with-all-entries (ent (loaded-sack frame))
133+ (updating-output (stream :unique-id ent)
134+ (present ent 'cl-sack:sack-entry :stream stream)
135+ (terpri stream))))
136+
137+(define-main-window-command (com/rename-entry :name nil)
138+ ((ent sack-entry-name :gesture :select))
139+ (let ((new-name (accept 'string :stream (frame-standard-input *main-window*)
140+ :prompt "New name" :default (cl-sack:name ent))))
141+ (setf new-name (p36:trim-whitespace new-name))
142+ (if (string= new-name "")
143+ (format-error t "Name cannot be blank")
144+ (setf (cl-sack:name ent) new-name))))
145+
146+;;;
147+;;; Menus and Other Commands
148+;;;
149+
150+(define-main-window-command (com/about :name nil)
76151 ()
77- (format (frame-standard-output *main-window*) "Not yet implemented~%"))
152+ (format-error t "Not yet implemented~%"))
153+
154+(define-main-window-command (com/new :name "New Sack" :keystroke (#\N :control))
155+ ()
156+ (format-error t "Not yet implemented~%"))
78157
79158 (define-main-window-command (com/open :name "Open Sack" :keystroke (#\o :control))
80159 ((really-open? 'boolean :gesture :select
@@ -85,7 +164,7 @@
85164 (return-from com/open))
86165
87166 (let ((filename "")
88- (out (frame-standard-output *main-window*)))
167+ (out (frame-standard-input *main-window*)))
89168 (accepting-values ()
90169 (setf filename (accept 'pathname :prompt "Path to Sack file")))
91170
@@ -105,19 +184,18 @@
105184
106185 (setf (loaded-sack *main-window*) (cl-sack:load-sack filename))
107186 (format out "Sack file loaded, ~a entries found.~%" (cl-sack:num-entries (loaded-sack *main-window*)))
187+ (format out "~a~%" (loaded-sack *main-window*))
108188 (setf (needs-saving-p *main-window*) nil))))))
109189
110190 (define-main-window-command (com/save :name "Save" :keystroke (#\s :control))
111191 ()
112- (format (frame-standard-output *main-window*) "Not yet implemented~%"))
192+ (format-error t "Not yet implemented~%"))
113193
114-(define-main-window-command (com/save-as :name "Save As...")
194+(define-main-window-command (com/save-as :name nil)
115195 ()
116- (format (frame-standard-output *main-window*) "Not yet implemented~%"))
196+ (format-error t "Not yet implemented~%"))
117197
118198 (define-main-window-command (com/quit :name "Quit" :keystroke (#\q :control))
119- ((really-quit? 'boolean
120- :gesture :select
121- :prompt "Are you sure you want to quit?"))
199+ ((really-quit? 'boolean :gesture :select :prompt "Are you sure you want to quit?"))
122200 (when really-quit?
123201 (frame-exit *main-window*)))
diff -r c9f6ddba5fab -r 96b76fca0810 gsacked-src/presentations.lisp
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/gsacked-src/presentations.lisp Tue Feb 12 00:51:02 2019 -0700
@@ -0,0 +1,26 @@
1+;;;; GSacked - A graphical tool to create and edit Sack files
2+;;;; Copyright (C) 2016 Alexa Jones-Gonzales <alexa@partition36.com>
3+;;;;
4+;;;; This program is free software: you can redistribute it and/or modify
5+;;;; it under the terms of the GNU General Public License as published by
6+;;;; the Free Software Foundation, either version 3 of the License, or
7+;;;; (at your option) any later version.
8+;;;;
9+;;;; This program is distributed in the hope that it will be useful,
10+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+;;;; GNU General Public License for more details.
13+;;;;
14+;;;; You should have received a copy of the GNU General Public License
15+;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16+(in-package :p36.gsacked)
17+
18+(define-presentation-type cl-sack:sack-entry ())
19+
20+(define-presentation-method present (object (type cl-sack:sack-entry) stream view &key)
21+ (declare (ignore view))
22+
23+ (write-string (cl-sack:name object) stream))
24+
25+(define-presentation-type sack-entry-name ())
26+(define-presentation-type sack-entry-type ())
diff -r c9f6ddba5fab -r 96b76fca0810 gsacked-src/util.lisp
--- a/gsacked-src/util.lisp Fri Feb 08 16:45:39 2019 -0700
+++ b/gsacked-src/util.lisp Tue Feb 12 00:51:02 2019 -0700
@@ -28,3 +28,13 @@
2828 (if (find-package :swank)
2929 (error "DIE-NOW called!")
3030 (p36:exit 255))))
31+
32+(defmacro format-error (stream msg &rest fmt-args)
33+ (p36:with-gensyms (real-stream)
34+ `(let ((,real-stream ,(if (equalp stream t)
35+ (list 'frame-standard-input '*main-window*)
36+ stream)))
37+ (with-drawing-options (,real-stream :ink +red2+)
38+ (with-text-face (,real-stream :bold)
39+ (format ,real-stream "Error: ")))
40+ (format ,real-stream ,msg ,@fmt-args))))
diff -r c9f6ddba5fab -r 96b76fca0810 gsacked.asd
--- a/gsacked.asd Fri Feb 08 16:45:39 2019 -0700
+++ b/gsacked.asd Tue Feb 12 00:51:02 2019 -0700
@@ -47,6 +47,7 @@
4747 (:file "globals")
4848 (:file "util")
4949
50+ (:file "presentations")
5051 (:file "gui-main-window")
5152
5253 (:file "main")))))
Show on old repository browser