CL-Sack is a Common Lisp library for making and manipulating Sack files.
| Revision | 3ead5084710a54aeb7bc40ed0b187cfbd6a3d02a (tree) |
|---|---|
| Time | 2019-02-18 22:03:25 |
| Author | Alexa Jones-Gonzales <alexa@part...> |
| Commiter | Alexa Jones-Gonzales |
Started to implement metadata editing
gsacked-src/gui-main-window.lisp (diff) gsacked-src/presentations.lisp (diff)| @@ -52,6 +52,10 @@ | ||
| 52 | 52 | :initform nil |
| 53 | 53 | :reader data-pane) |
| 54 | 54 | |
| 55 | + (metadata-pane | |
| 56 | + :initform nil | |
| 57 | + :reader metadata-pane) | |
| 58 | + | |
| 55 | 59 | (interaction-pane |
| 56 | 60 | :initform nil |
| 57 | 61 | :reader interactor)) |
| @@ -70,6 +74,12 @@ | ||
| 70 | 74 | :incremental-redisplay t |
| 71 | 75 | :display-function 'display-entry-metadata) |
| 72 | 76 | |
| 77 | + (new-metadata :push-button | |
| 78 | + :label "New Metadata Pair" | |
| 79 | + :activate-callback #'(lambda (x) | |
| 80 | + (declare (ignore x)) | |
| 81 | + (com/new-metadata-pair))) | |
| 82 | + | |
| 73 | 83 | (pdoc :pointer-documentation)) |
| 74 | 84 | |
| 75 | 85 | (:menu-bar menu/main-window) |
| @@ -86,15 +96,22 @@ | ||
| 86 | 96 | (1/5 (labelling (:label "Entry Information") |
| 87 | 97 | data-view)) |
| 88 | 98 | (+fill+ (labelling (:label "Entry Metadata") |
| 89 | - metadata-view)))))) | |
| 99 | + metadata-view)) | |
| 100 | + | |
| 101 | + (1/8 new-metadata))))) | |
| 90 | 102 | |
| 91 | 103 | (1/4 int) |
| 92 | 104 | |
| 93 | 105 | pdoc)))) |
| 94 | 106 | |
| 95 | 107 | (defmethod initialize-instance :after ((obj main-window) &key) |
| 96 | - (setf (slot-value obj 'interaction-pane) (find-pane-named obj 'int)) | |
| 97 | - (setf (slot-value obj 'data-pane) (find-pane-named obj 'data-view))) | |
| 108 | + (with-slots ((ip interaction-pane) | |
| 109 | + (dp data-pane) | |
| 110 | + (mp metadata-pane)) | |
| 111 | + obj | |
| 112 | + (setf ip (find-pane-named obj 'int)) | |
| 113 | + (setf dp (find-pane-named obj 'data-view)) | |
| 114 | + (setf mp (find-pane-named obj 'metadata-view)))) | |
| 98 | 115 | |
| 99 | 116 | ;;; |
| 100 | 117 | ;;; Entry Commands |
| @@ -108,7 +125,7 @@ | ||
| 108 | 125 | (let ((new-name "") |
| 109 | 126 | (new-type :data) |
| 110 | 127 | (stream (frame-standard-input *main-window*))) |
| 111 | - (window-clear stream) | |
| 128 | + | |
| 112 | 129 | (accepting-values (stream :own-window t) |
| 113 | 130 | (setf new-name (accept 'string :stream stream :prompt "Name")) |
| 114 | 131 | (terpri stream) |
| @@ -163,7 +180,20 @@ | ||
| 163 | 180 | (terpri stream)))) |
| 164 | 181 | |
| 165 | 182 | (defmethod display-entry-metadata ((frame main-window) stream) |
| 166 | - t) | |
| 183 | + (let ((ent (selected-entry frame))) | |
| 184 | + (when ent | |
| 185 | + (updating-output (stream :unique-id ent) | |
| 186 | + (formatting-table (stream) | |
| 187 | + (cl-sack:with-all-metadata (key val ent) | |
| 188 | + (formatting-row (stream) | |
| 189 | + (formatting-cell (stream) | |
| 190 | + (write-sack-entry-metadata-key stream ent key)) | |
| 191 | + | |
| 192 | + (formatting-cell (stream) | |
| 193 | + (write-sack-entry-metadata-value stream ent key))))) | |
| 194 | + | |
| 195 | + (italicized (stream) (format nil "~%Total metadata pairs: ")) | |
| 196 | + (format stream "~:d~%" (cl-sack:get-metadata-count ent)))))) | |
| 167 | 197 | |
| 168 | 198 | (define-main-window-command (com/rename-entry :name nil) |
| 169 | 199 | ((ent sack-entry-name :gesture :select)) |
| @@ -186,6 +216,39 @@ | ||
| 186 | 216 | (:data cl-sack:+entry-type-data+) |
| 187 | 217 | (:sack cl-sack:+entry-type-sack+))))) |
| 188 | 218 | |
| 219 | +(define-main-window-command (com/new-metadata-pair :name nil) | |
| 220 | + () | |
| 221 | + (let ((new-key "") | |
| 222 | + (new-value "") | |
| 223 | + (ent (selected-entry *main-window*)) | |
| 224 | + (stream (frame-standard-input *main-window*))) | |
| 225 | + | |
| 226 | + (cond | |
| 227 | + (ent | |
| 228 | + (accepting-values (stream :own-window t) | |
| 229 | + (setf new-key (accept 'string :stream stream :prompt "Key")) | |
| 230 | + (terpri stream) | |
| 231 | + | |
| 232 | + (setf new-value (accept 'string :stream stream :prompt "Value")) | |
| 233 | + (terpri stream)) | |
| 234 | + | |
| 235 | + (setf (cl-sack:get-metadata ent new-key) new-value)) | |
| 236 | + | |
| 237 | + (t (format-error stream "No entry selected~%"))))) | |
| 238 | + | |
| 239 | +(define-main-window-command (com/change-metadata-key :name nil) | |
| 240 | + ((key sack-entry-metadata-key :gesture :select)) | |
| 241 | + (let ((ent (selected-entry *main-window*))) | |
| 242 | + (if ent | |
| 243 | + (let* ((old-val (cl-sack:get-metadata ent key)) | |
| 244 | + (new-key (accept 'string :default key | |
| 245 | + :stream (frame-standard-input *main-window*) | |
| 246 | + :prompt "New key"))) | |
| 247 | + (cl-sack:remove-metadata ent key) | |
| 248 | + (setf (cl-sack:get-metadata ent new-key) old-val)) | |
| 249 | + | |
| 250 | + (format-error nil "No entry selected~%")))) | |
| 251 | + | |
| 189 | 252 | ;;; |
| 190 | 253 | ;;; Menus and Other Commands |
| 191 | 254 | ;;; |
| @@ -15,20 +15,30 @@ | ||
| 15 | 15 | ;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. |
| 16 | 16 | (in-package :p36.gsacked) |
| 17 | 17 | |
| 18 | +;;; | |
| 19 | +;;; | |
| 20 | +;;; | |
| 21 | + | |
| 18 | 22 | (define-presentation-type cl-sack:sack-entry ()) |
| 19 | 23 | |
| 20 | 24 | (define-presentation-method present (object (type cl-sack:sack-entry) stream view &key) |
| 21 | 25 | (declare (ignore view)) |
| 26 | + (write-string (cl-sack:name object) stream)) | |
| 22 | 27 | |
| 23 | - (write-string (cl-sack:name object) stream)) | |
| 28 | +;;; | |
| 29 | +;;; | |
| 30 | +;;; | |
| 24 | 31 | |
| 25 | 32 | (define-presentation-type sack-entry-name ()) |
| 26 | 33 | (defmacro write-sack-entry-name (stream ent) |
| 27 | 34 | `(with-output-as-presentation (,stream ,ent 'sack-entry-name) |
| 28 | 35 | (write-string (cl-sack:name ,ent) ,stream))) |
| 29 | 36 | |
| 37 | +;;; | |
| 38 | +;;; | |
| 39 | +;;; | |
| 40 | + | |
| 30 | 41 | (define-presentation-type cl-sack:t/entry-type ()) |
| 31 | - | |
| 32 | 42 | (define-presentation-method present (object (type cl-sack:t/entry-type) stream view &key) |
| 33 | 43 | (declare (ignore view)) |
| 34 | 44 |
| @@ -42,3 +52,19 @@ | ||
| 42 | 52 | (cl-sack:number->entry-type-name (cl-sack:parent ,ent) |
| 43 | 53 | (cl-sack:entry-type ,ent)) |
| 44 | 54 | ,stream))) |
| 55 | + | |
| 56 | +;;; | |
| 57 | +;;; | |
| 58 | +;;; | |
| 59 | + | |
| 60 | +(define-presentation-type sack-entry-metadata-key (entry)) | |
| 61 | +(define-presentation-type sack-entry-metadata-value (entry)) | |
| 62 | + | |
| 63 | +(defmacro write-sack-entry-metadata-key (stream ent key) | |
| 64 | + `(with-text-face (,stream :italic) | |
| 65 | + (with-output-as-presentation (,stream (list ,key ,ent) 'sack-entry-metadata-key) | |
| 66 | + (write-string ,key ,stream)))) | |
| 67 | + | |
| 68 | +(defmacro write-sack-entry-metadata-value (stream ent key) | |
| 69 | + `(with-output-as-presentation (,stream (list ,key ,ent) 'sack-entry-metadata-value) | |
| 70 | + (write-string (cl-sack:get-metadata ,ent ,key) ,stream))) |
Fork