Merge pull request #3266 from atlas-engineer/parse-existing-buffer-co…

…ntexts renderer/gtk(context-source): Parse the existing contexts.
atlas-engineer · Dec 8, 2023 · fac983f · fac983f
2 parents 0606d06 + bd67674
commit fac983f
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 4 deletions.
diff --git a/source/changelog.lisp b/source/changelog.lisp
@@ -934,7 +934,8 @@ invoked via " (:code "flatpak-spawn --host <command> <command-args>") "."))))
   (:nsection :title "Bug fixes"
     (:ul
      (:li "Fix command "
-          (:nxref :command 'nyxt/mode/annotate:show-annotations-for-current-url) "."))))
+          (:nxref :command 'nyxt/mode/annotate:show-annotations-for-current-url) ".")
+     (:li "make-buffer-with-context lists previously defined contexts."))))
 
 (define-version "4-pre-release-1"
   (:li "When on pre-release, push " (:code "X-pre-release")

diff --git a/source/renderer/gtk.lisp b/source/renderer/gtk.lisp
@@ -2226,11 +2226,26 @@ As a second value, return the current buffer index starting from 0."
 WebKit-specific."
   (webkit:webkit-web-view-reload-bypass-cache (gtk-object buffer)))
 
+(defun list-existing-contexts ()
+  (loop for dir in (uiop:subdirectories
+                    (files:expand (make-instance 'nyxt:nyxt-data-directory)))
+        ;; PATHNAME-DIRECTORY returns a list on most implementations (UIOP
+        ;; relies on that, at least), even though the standard doesn't mandate
+        ;; it.
+        for dirname = (alex:lastcar (uiop:ensure-list (pathname-directory dir)))
+        when (uiop:string-suffix-p dirname "web-context")
+          collect (subseq dirname
+                          0
+                          (- (length dirname) (length "web-context/")))))
+
 (define-class context-source (prompter:source)
   ((prompter:name "Context list")
-   (prompter:constructor (sort (delete-duplicates (append (mapcar #'context-name (buffer-list))
-                                                          (list +internal+ +default+))
-                                                  :test 'equal)
+   (prompter:constructor (sort (delete-duplicates
+                                (append
+                                 (mapcar #'context-name (buffer-list))
+                                 (list +internal+ +default+)
+                                 (list-existing-contexts))
+                                :test 'equal)
                                'string<)))
   (:export-class-name-p t))