Browse code

new commands to list and select open buffers

D Herring authored on 2012-05-13 15:29:37
Showing 2 changed files
... ...
@@ -60,6 +60,7 @@
60 60
 (defparameter *key-reload-file* "<Control-r>" "Re-load the current file")
61 61
 (defparameter *key-compile-file* "<Control-k>" "Compile the current file")
62 62
 (defparameter *key-next-file* "<Control-b>" "Cycle through open files")
63
+(defparameter *key-select-file* "<Control-B>" "Select open file")
63 64
 (defparameter *key-find* "<Control-f>" "Find text in current file")
64 65
 (defparameter *key-find-again* "<Control-g>" "Repeat the previous search")
65 66
 (defparameter *key-cut* "<Control-x>" "Cut the selected text")
... ...
@@ -536,6 +536,17 @@
536 536
 (defmethod get-current-text-ctrl ((buffer-manager buffer-manager))
537 537
   (edit-ctrl (selected-buffer buffer-manager)))
538 538
 
539
+(defun update-current-buffers (buffer-manager)
540
+  (ltk:menu-delete *buffer-menubar* 5)
541
+  (loop for b in (reverse (buffers buffer-manager))
542
+    for c from 1
543
+    do (ltk:make-menubutton
544
+         *buffer-menubar*
545
+         (format nil "~A: ~A" c (file-path b))
546
+         (let ((n c))
547
+           (lambda ()
548
+             (on-select-file n))))))
549
+
539 550
 (defmethod add-buffer ((buffer-manager buffer-manager) file-path &optional open-file-p)
540 551
   (if (not (find-buffer buffer-manager file-path))
541 552
       (let* ((newbuffer (make-instance 'buffer :file-path file-path :master *editor-frame*))
... ...
@@ -546,7 +557,8 @@
546 557
         (ltk:configure text-ctrl :undo 1)
547 558
         (ltk::set-cursor-pos text-ctrl "1.0")
548 559
         (push newbuffer (buffers buffer-manager))))
549
-  (select-buffer buffer-manager file-path))
560
+  (select-buffer buffer-manager file-path)
561
+  (update-current-buffers buffer-manager))
550 562
 
551 563
 (defmethod find-buffer ((buffer-manager buffer-manager) path-name)
552 564
   (loop for buffer in (reverse (buffers buffer-manager)) do
... ...
@@ -621,6 +633,7 @@
621 633
 
622 634
 (defmethod close-buffer ((buffer buffer) (buffer-manager buffer-manager))
623 635
   (setf (buffers buffer-manager) (remove buffer (buffers buffer-manager) :test #'equalp))
636
+  (update-current-buffers buffer-manager)
624 637
   (let ((nextfile (get-next-buffer buffer buffer-manager)))
625 638
     (select-next-buffer buffer-manager buffer)
626 639
     (ltk:pack-forget buffer)
... ...
@@ -974,6 +987,7 @@
974 987
      (list *key-goto-line* 'on-goto)
975 988
      (list *key-asdf-load* 'on-asdf-load)
976 989
      (list *key-next-file* 'on-next-file)
990
+     (list *key-select-file* 'on-select-file)
977 991
      (list *key-reload-file* 'on-reload-file)
978 992
      (list *key-compile-file* 'on-compile-file)
979 993
      (list *key-invoke-debugger* 'on-invoke-debugger)
... ...
@@ -997,12 +1011,15 @@
997 1011
     (destructuring-bind (key action) entry
998 1012
       (add-key-binding ltk::*tk* key action))))
999 1013
 
1014
+(defparameter *buffer-menubar* nil "store a reference to the buffer menubar for listing the open buffers")
1015
+
1000 1016
 (defun create-menus ()
1001 1017
   (let* ((mb (ltk:make-menubar))
1002 1018
          (mfile (ltk:make-menu mb "File"))
1003 1019
          (medit (ltk:make-menu mb "Edit"))
1004 1020
          (mbuffer (ltk:make-menu mb "Buffers"))
1005 1021
          (mlisp (ltk:make-menu mb "Lisp")))
1022
+    (setf *buffer-menubar* mbuffer)
1006 1023
 
1007 1024
     (macrolet ((with-menu (menu &body body)
1008 1025
                  `(macrolet
... ...
@@ -1047,7 +1064,12 @@
1047 1064
       (with-menu mbuffer
1048 1065
         (action "Next buffer" on-next-file)
1049 1066
         (separator)
1050
-        (action "Close buffer" on-close-file))
1067
+        (action "Close buffer" on-close-file)
1068
+	(separator)
1069
+	(action "Select buffer" on-select-file)
1070
+	;; sacrificial placeholder for the current buffer list
1071
+	;; update the magic number in update-current-buffers when adding/removing entries
1072
+	(ltk:make-menubutton mbuffer "" nil))
1051 1073
       (with-menu mlisp
1052 1074
         (text-action "Macroexpand" on-macro-expand)
1053 1075
         (text-action "Copy to REPL" on-copy-sexp-to-repl)
... ...
@@ -1190,6 +1212,15 @@
1190 1212
 (defun on-next-file (&optional event)
1191 1213
   (select-next-buffer *buffer-manager* (selected-buffer *buffer-manager*)))
1192 1214
 
1215
+(defun on-select-file (&optional n)
1216
+  (unless (integerp n)
1217
+    (setf n (parse-integer (input-prompt *listener* "buffer number:"))))
1218
+  (when (integerp n)
1219
+    (select-buffer *buffer-manager*
1220
+      ;; compensate for the reversed order
1221
+      (- (length (buffers *buffer-manager*)) n)))
1222
+  (prompt *listener* :clear t))
1223
+
1193 1224
 (defun on-file-modified (evt)
1194 1225
   (pathname-message))
1195 1226
 
... ...
@@ -1353,9 +1384,9 @@
1353 1384
       (ltk:on-close ltk::*tk* 'on-quit)
1354 1385
       (ltk:set-geometry ltk::*tk* *window-width* *window-height* *window-x* *window-y*)
1355 1386
       (ltk:minsize ltk::*tk* 320 200)
1356
-      (on-new-file)
1357 1387
       (bind-commands)
1358 1388
       (create-menus)
1389
+      (on-new-file) ;; create the new file after the menus so it is listed in the current buffer list
1359 1390
 
1360 1391
       (when old-manager
1361 1392
         (dolist (buf (reverse (buffers old-manager)))