591 lines
27 KiB
EmacsLisp
591 lines
27 KiB
EmacsLisp
|
;;; burly.el --- Save and restore frame/window configurations with buffers -*- lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2020 Adam Porter
|
||
|
|
|
||
|
|
;; Author: Adam Porter <adam@alphapapa.net>
|
||
|
|
;; URL: https://github.com/alphapapa/burly.el
|
||
|
|
;; Version: 0.3-pre
|
||
|
|
;; Package-Requires: ((emacs "27.1") (map "2.1"))
|
||
|
|
;; Keywords: convenience
|
||
|
|
|
||
|
|
;; This program is free software; you can redistribute it and/or modify
|
||
|
|
;; it under the terms of the GNU General Public License as published by
|
||
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
||
|
|
;; (at your option) any later version.
|
||
|
|
|
||
|
|
;; This program is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
;; GNU General Public License for more details.
|
||
|
|
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; Commentary:
|
||
|
|
|
||
|
|
;; This package provides tools to save and restore frame and window
|
||
|
|
;; configurations in Emacs, including buffers that may not be live
|
||
|
|
;; anymore. In this way, it's like a lightweight "workspace" manager,
|
||
|
|
;; allowing you to easily restore one or more frames, including their
|
||
|
|
;; windows, the windows' layout, and their buffers.
|
||
|
|
|
||
|
|
;; Internally it uses Emacs's bookmarks system to restore buffers to
|
||
|
|
;; their previous contents and location. This provides power and
|
||
|
|
;; extensibility, since many major modes already integrate with
|
||
|
|
;; Emacs's bookmarks system. However, in case a mode's bookmarking
|
||
|
|
;; function isn't satisfactory, Burly allows the user to customize
|
||
|
|
;; buffer-restoring functions for specific modes.
|
||
|
|
|
||
|
|
;; For Org mode, Burly provides such custom functions so that narrowed
|
||
|
|
;; and indirect Org buffers are properly restored, and headings are
|
||
|
|
;; located by outline path in case they've moved since a bookmark was
|
||
|
|
;; made (the org-bookmark-heading package also provides this through
|
||
|
|
;; the Emacs bookmark system, but users may not have it installed, and
|
||
|
|
;; the functionality is too useful to not include here by default).
|
||
|
|
|
||
|
|
;; Internally, buffers and window configurations are also encoded as
|
||
|
|
;; URLs, and users may also save and open those URLs instead of using
|
||
|
|
;; Emacs bookmarks. (The name "Burly" comes from "buffer URL.")
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
;;;; Requirements
|
||
|
|
|
||
|
|
(require 'bookmark)
|
||
|
|
(require 'cl-lib)
|
||
|
|
(require 'map)
|
||
|
|
(require 'subr-x)
|
||
|
|
(require 'thingatpt)
|
||
|
|
(require 'url-parse)
|
||
|
|
(require 'url-util)
|
||
|
|
|
||
|
|
;;;; Variables
|
||
|
|
|
||
|
|
(defvar burly--window-state nil
|
||
|
|
"Used to work around `bookmark--jump-via' affecting window configuration.")
|
||
|
|
|
||
|
|
(defvar burly-opened-bookmark-name nil
|
||
|
|
"The name of the last bookmark opened by Burly.")
|
||
|
|
|
||
|
|
;;;; Customization
|
||
|
|
|
||
|
|
(defgroup burly nil
|
||
|
|
"Save and restore window configurations and their buffers."
|
||
|
|
:group 'convenience
|
||
|
|
:link '(url-link "https://github.com/alphapapa/burly.el")
|
||
|
|
:link '(custom-manual "(Burly)Usage"))
|
||
|
|
|
||
|
|
(defcustom burly-bookmark-prefix "Burly: "
|
||
|
|
"Prefix string for the name of new Burly bookmarks."
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
(defcustom burly-major-mode-alist
|
||
|
|
(list (cons 'org-mode
|
||
|
|
(list (cons 'make-url-fn #'burly--org-mode-buffer-url)
|
||
|
|
(cons 'follow-url-fn #'burly-follow-url-org-mode))))
|
||
|
|
"Alist mapping major modes to the appropriate Burly functions."
|
||
|
|
:type '(alist :key-type symbol
|
||
|
|
:value-type (set (cons (const make-url-fn) (function :tag "Make-URL function"))
|
||
|
|
(cons (const follow-url-fn) (function :tag "Follow-URL function")))))
|
||
|
|
|
||
|
|
(defcustom burly-frameset-filter-alist '((name . nil))
|
||
|
|
"Alist of frame parameters and filtering functions.
|
||
|
|
See variable `frameset-filter-alist'."
|
||
|
|
:type '(alist :key-type (symbol :tag "Frame parameter")
|
||
|
|
:value-type (choice (const :tag "Always copied" nil)
|
||
|
|
(const :tag "Never copied" :never)
|
||
|
|
(function :tag "Filter function"))))
|
||
|
|
|
||
|
|
(defcustom burly-window-persistent-parameters
|
||
|
|
(list (cons 'burly-url 'writable)
|
||
|
|
(cons 'header-line-format 'writable)
|
||
|
|
(cons 'mode-line-format 'writable)
|
||
|
|
(cons 'tab-line-format 'writable)
|
||
|
|
(cons 'no-other-window 'writable)
|
||
|
|
(cons 'no-delete-other-windows 'writable)
|
||
|
|
(cons 'window-preserved-size 'writable)
|
||
|
|
(cons 'window-side 'writable)
|
||
|
|
(cons 'window-slot 'writable))
|
||
|
|
"Additional window parameters to persist.
|
||
|
|
See Info node `(elisp)Window Parameters'. See also option
|
||
|
|
`burly-set-window-persistent-parameters'."
|
||
|
|
:type '(alist :key-type (symbol :tag "Window parameter")
|
||
|
|
:value-type (choice (const :tag "Not saved" nil)
|
||
|
|
(const :tag "Saved" writable))))
|
||
|
|
|
||
|
|
(defcustom burly-set-window-persistent-parameters t
|
||
|
|
"Sync `window-persistent-parameters' with `burly' option.
|
||
|
|
When this option is non-nil, `window-persistent-parameters' is
|
||
|
|
set to the value of `burly-window-persistent-parameters' when
|
||
|
|
Burly restores a window configuration.
|
||
|
|
|
||
|
|
By default, `window-persistent-parameters' does not save many of
|
||
|
|
the parameters that are in the default value of
|
||
|
|
`burly-window-persistent-parameters', which causes, e.g. a
|
||
|
|
built-in command like `window-toggle-side-windows' to not persist
|
||
|
|
such parameters when side windows are toggled (which could,
|
||
|
|
e.g. cause a window's `mode-line-format' to not persist). So
|
||
|
|
enabling this option solves that.
|
||
|
|
|
||
|
|
Note: When this option is non-nil,
|
||
|
|
`burly-window-persistent-parameters' should be set heeding the
|
||
|
|
warning in the manual about not using the `writable' value for
|
||
|
|
parameters whose values do not have a read syntax."
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
;;;; Commands
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-open-last-bookmark ()
|
||
|
|
"Open the last-opened Burly bookmark.
|
||
|
|
Helpful for, e.g. quickly restoring an overview while working on
|
||
|
|
a project."
|
||
|
|
(interactive)
|
||
|
|
(unless burly-opened-bookmark-name
|
||
|
|
(user-error "Use command `burly-open-bookmark' first"))
|
||
|
|
(burly-open-bookmark burly-opened-bookmark-name))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-kill-buffer-url (buffer)
|
||
|
|
"Copy BUFFER's URL to the kill ring."
|
||
|
|
(interactive "bBuffer: ")
|
||
|
|
(let ((url (burly-buffer-url (get-buffer buffer))))
|
||
|
|
(kill-new url)
|
||
|
|
(message "%s" url)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-kill-frames-url ()
|
||
|
|
"Copy current frameset's URL to the kill ring."
|
||
|
|
(interactive)
|
||
|
|
(let ((url (burly-frames-url)))
|
||
|
|
(kill-new url)
|
||
|
|
(message "%s" url)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-kill-windows-url ()
|
||
|
|
"Copy current frame's window configuration URL to the kill ring."
|
||
|
|
(interactive)
|
||
|
|
(let ((url (burly-windows-url)))
|
||
|
|
(kill-new url)
|
||
|
|
(message "%s" url)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-open-url (url)
|
||
|
|
"Open Burly URL."
|
||
|
|
;; FIXME: If point is on an "emacs+burly..." URL, but it's after the "emacs+burly"
|
||
|
|
;; part, `thing-at-point-url-at-point' doesn't pick up the whole URL.
|
||
|
|
(interactive (list (or (thing-at-point-url-at-point t)
|
||
|
|
(read-string "URL: "))))
|
||
|
|
(cl-assert (string-prefix-p "emacs+burly+" url) t "burly-open-url: URL not an emacs+burly one:")
|
||
|
|
(pcase-let* ((urlobj (url-generic-parse-url url))
|
||
|
|
((cl-struct url type) urlobj)
|
||
|
|
(subtype (car (last (split-string type "+" 'omit-nulls)))))
|
||
|
|
(pcase-exhaustive subtype
|
||
|
|
((or "bookmark" "file" "name") (pop-to-buffer (burly-url-buffer url)))
|
||
|
|
("frames" (burly--frameset-restore urlobj))
|
||
|
|
("windows" (burly--windows-set urlobj)))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-bookmark-frames (name)
|
||
|
|
"Bookmark the current frames as NAME."
|
||
|
|
(interactive
|
||
|
|
(list (completing-read "Save Burly bookmark: " (burly-bookmark-names)
|
||
|
|
nil nil burly-bookmark-prefix)))
|
||
|
|
(let ((record (list (cons 'url (burly-frames-url))
|
||
|
|
(cons 'handler #'burly-bookmark-handler))))
|
||
|
|
(bookmark-store name record nil)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-bookmark-windows (name)
|
||
|
|
"Bookmark the current frame's window configuration as NAME."
|
||
|
|
(interactive
|
||
|
|
(list (completing-read "Save Burly bookmark: " (burly-bookmark-names)
|
||
|
|
nil nil burly-bookmark-prefix)))
|
||
|
|
(let ((record (list (cons 'url (burly-windows-url))
|
||
|
|
(cons 'handler #'burly-bookmark-handler))))
|
||
|
|
(bookmark-store name record nil)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-open-bookmark (bookmark)
|
||
|
|
"Restore a window configuration to the current frame from a Burly BOOKMARK."
|
||
|
|
(interactive
|
||
|
|
(list (completing-read "Open Burly bookmark: " (burly-bookmark-names)
|
||
|
|
nil nil burly-bookmark-prefix)))
|
||
|
|
(cl-assert (and bookmark (not (string-empty-p bookmark))) nil
|
||
|
|
"(burly-open-bookmark): Invalid Burly bookmark: '%s'" bookmark)
|
||
|
|
(bookmark-jump bookmark))
|
||
|
|
|
||
|
|
;;;; Functions
|
||
|
|
|
||
|
|
;;;;; Buffers
|
||
|
|
|
||
|
|
(defun burly-url-buffer (url)
|
||
|
|
"Return buffer for URL."
|
||
|
|
(cl-assert (string-prefix-p "emacs+burly+" url) t "burly-url-buffer: URL not an emacs+burly one: %s" url)
|
||
|
|
(pcase-let* ((urlobj (url-generic-parse-url url))
|
||
|
|
((cl-struct url type) urlobj)
|
||
|
|
(subtype (car (last (split-string type "+" 'omit-nulls)))))
|
||
|
|
(pcase-exhaustive subtype
|
||
|
|
("bookmark" (burly--bookmark-url-buffer urlobj))
|
||
|
|
("file" (burly--file-url-buffer urlobj))
|
||
|
|
("name" (let ((buffer-name (decode-coding-string (cdr (url-path-and-query urlobj))
|
||
|
|
'utf-8-unix)))
|
||
|
|
(or (get-buffer buffer-name)
|
||
|
|
(with-current-buffer (get-buffer-create (concat "*Burly (error): " buffer-name "*"))
|
||
|
|
(insert "Burly was unable to get a buffer named: " buffer-name "\n"
|
||
|
|
"URL: " url "\n"
|
||
|
|
"Please report this error to the developer\n\n")
|
||
|
|
(current-buffer))))))))
|
||
|
|
|
||
|
|
(defun burly-buffer-url (buffer)
|
||
|
|
"Return URL for BUFFER."
|
||
|
|
(let* ((major-mode (buffer-local-value 'major-mode buffer))
|
||
|
|
(make-url-fn (map-nested-elt burly-major-mode-alist (list major-mode 'make-url-fn))))
|
||
|
|
(cond (make-url-fn (funcall make-url-fn buffer))
|
||
|
|
(t (or (with-current-buffer buffer
|
||
|
|
(when-let* ((record (ignore-errors
|
||
|
|
(bookmark-make-record))))
|
||
|
|
(cl-labels ((encode (element)
|
||
|
|
(cl-typecase element
|
||
|
|
(string (encode-coding-string element 'utf-8-unix))
|
||
|
|
(proper-list (mapcar #'encode element))
|
||
|
|
(cons (cons (encode (car element))
|
||
|
|
(encode (cdr element))))
|
||
|
|
(t element))))
|
||
|
|
;; Encode all strings in record with UTF-8.
|
||
|
|
;; NOTE: If we stop using URLs in the future, maybe this won't be needed.
|
||
|
|
(setf record (encode record)))
|
||
|
|
(burly--bookmark-record-url record)))
|
||
|
|
;; Buffer can't seem to be bookmarked, so record it as
|
||
|
|
;; a name-only buffer. For some reason, it works
|
||
|
|
;; better to use the buffer name in the query string
|
||
|
|
;; rather than the filename/path part.
|
||
|
|
(url-recreate-url (url-parse-make-urlobj "emacs+burly+name" nil nil nil nil
|
||
|
|
(concat "?" (encode-coding-string (buffer-name buffer)
|
||
|
|
'utf-8-unix))
|
||
|
|
nil nil 'fullness)))))))
|
||
|
|
|
||
|
|
;;;;; Files
|
||
|
|
|
||
|
|
(defun burly--file-url-buffer (urlobj)
|
||
|
|
"Return buffer for \"emacs+burly+file:\" URLOBJ."
|
||
|
|
(pcase-let* ((`(,path . ,query-string) (url-path-and-query urlobj))
|
||
|
|
(query (url-parse-query-string query-string))
|
||
|
|
(buffer (find-file-noselect path))
|
||
|
|
(major-mode (buffer-local-value 'major-mode buffer))
|
||
|
|
(follow-fn (map-nested-elt burly-major-mode-alist (list major-mode 'follow-url-fn))))
|
||
|
|
(cl-assert follow-fn nil "Major mode not in `burly-major-mode-alist': %s" major-mode)
|
||
|
|
(funcall follow-fn :buffer buffer :query query)))
|
||
|
|
|
||
|
|
;;;;; Frames
|
||
|
|
|
||
|
|
;; Looks like frameset.el should make this pretty easy.
|
||
|
|
|
||
|
|
(require 'frameset)
|
||
|
|
|
||
|
|
(cl-defun burly-frames-url (&optional (frames (frame-list)))
|
||
|
|
"Return URL for frameset of FRAMES.
|
||
|
|
FRAMES defaults to all live frames."
|
||
|
|
(dolist (frame frames)
|
||
|
|
;; Set URL window parameter for each window before saving state.
|
||
|
|
(burly--windows-set-url (window-list frame 'never)))
|
||
|
|
(let* ((window-persistent-parameters (append burly-window-persistent-parameters
|
||
|
|
window-persistent-parameters))
|
||
|
|
(frameset-filter-alist (append burly-frameset-filter-alist frameset-filter-alist))
|
||
|
|
(query (frameset-save frames))
|
||
|
|
(print-length nil) ; Important!
|
||
|
|
(filename (concat "?" (url-hexify-string (prin1-to-string query))))
|
||
|
|
(url (url-recreate-url (url-parse-make-urlobj "emacs+burly+frames" nil nil nil nil
|
||
|
|
filename))))
|
||
|
|
(dolist (frame frames)
|
||
|
|
;; Clear window parameters.
|
||
|
|
(burly--windows-set-url (window-list frame 'never) 'nullify))
|
||
|
|
url))
|
||
|
|
|
||
|
|
(defun burly--frameset-restore (urlobj)
|
||
|
|
"Restore FRAMESET according to URLOBJ."
|
||
|
|
(setf window-persistent-parameters (copy-sequence burly-window-persistent-parameters))
|
||
|
|
(pcase-let* ((`(,_ . ,query-string) (url-path-and-query urlobj))
|
||
|
|
(frameset (read (url-unhex-string query-string)))
|
||
|
|
(frameset-filter-alist (append burly-frameset-filter-alist frameset-filter-alist)))
|
||
|
|
;; Restore buffers. (Apparently `cl-loop''s in-ref doesn't work with
|
||
|
|
;; its destructuring, so we can't just `setf' on `window-state'.)
|
||
|
|
(setf (frameset-states frameset)
|
||
|
|
(cl-loop for (frame-parameters . window-state) in (frameset-states frameset)
|
||
|
|
collect (cons frame-parameters (burly--bufferize-window-state window-state))))
|
||
|
|
(condition-case err
|
||
|
|
(frameset-restore frameset)
|
||
|
|
(error (delay-warning 'burly (format "Error while restoring frameset: ERROR:%S FRAMESET:%S" err frameset))))))
|
||
|
|
|
||
|
|
;;;;; Windows
|
||
|
|
|
||
|
|
(cl-defun burly-windows-url (&optional (frame (selected-frame)))
|
||
|
|
"Return URL for window configuration on FRAME."
|
||
|
|
(with-selected-frame frame
|
||
|
|
(let* ((query (burly--window-state frame))
|
||
|
|
(print-length nil) ; Important!
|
||
|
|
(filename (concat "?" (url-hexify-string (prin1-to-string query)))))
|
||
|
|
(url-recreate-url (url-parse-make-urlobj "emacs+burly+windows" nil nil nil nil
|
||
|
|
filename)))))
|
||
|
|
|
||
|
|
(cl-defun burly--window-state (&optional (frame (selected-frame)))
|
||
|
|
"Return window state for FRAME.
|
||
|
|
Sets `burly-url' window parameter in each window before
|
||
|
|
serializing."
|
||
|
|
(with-selected-frame frame
|
||
|
|
;; Set URL window parameter for each window before saving state.
|
||
|
|
(burly--windows-set-url (window-list nil 'never))
|
||
|
|
(let* ((window-persistent-parameters (append burly-window-persistent-parameters
|
||
|
|
window-persistent-parameters))
|
||
|
|
(window-state (window-state-get nil 'writable)))
|
||
|
|
;; Clear window parameters we set (because they aren't kept
|
||
|
|
;; current, so leaving them could be confusing).
|
||
|
|
(burly--windows-set-url (window-list nil 'never) 'nullify)
|
||
|
|
window-state)))
|
||
|
|
|
||
|
|
(defun burly--windows-set-url (windows &optional nullify)
|
||
|
|
"Set `burly-url' window parameter in WINDOWS.
|
||
|
|
If NULLIFY, set the parameter to nil."
|
||
|
|
(dolist (window windows)
|
||
|
|
(let ((value (if nullify nil (burly-buffer-url (window-buffer window)))))
|
||
|
|
(set-window-parameter window 'burly-url value))))
|
||
|
|
|
||
|
|
(defun burly--windows-set (urlobj)
|
||
|
|
"Set window configuration according to URLOBJ."
|
||
|
|
(setf window-persistent-parameters (copy-sequence burly-window-persistent-parameters))
|
||
|
|
(pcase-let* ((window-persistent-parameters (append burly-window-persistent-parameters
|
||
|
|
window-persistent-parameters))
|
||
|
|
(`(,_ . ,query-string) (url-path-and-query urlobj))
|
||
|
|
;; FIXME: Remove this condition-case eventually, after giving users time to update their bookmarks.
|
||
|
|
(state (condition-case nil
|
||
|
|
(read (url-unhex-string query-string))
|
||
|
|
(invalid-read-syntax (display-warning 'burly "Please recreate that Burly bookmark (storage format changed)")
|
||
|
|
(read query-string))))
|
||
|
|
(state (burly--bufferize-window-state state)))
|
||
|
|
(window-state-put state (frame-root-window))
|
||
|
|
;; HACK: Since `bookmark--jump-via' insists on calling a
|
||
|
|
;; buffer-display function after handling the bookmark, we add a
|
||
|
|
;; function to `bookmark-after-jump-hook' to restore the window
|
||
|
|
;; configuration that we just set.
|
||
|
|
(setf burly--window-state (window-state-get (frame-root-window) 'writable))
|
||
|
|
(push #'burly--bookmark-window-state-hack bookmark-after-jump-hook)))
|
||
|
|
|
||
|
|
(defun burly--bufferize-window-state (state)
|
||
|
|
"Return window state STATE with its buffers reincarnated."
|
||
|
|
(cl-labels ((bufferize-state
|
||
|
|
;; Set windows' buffers in STATE.
|
||
|
|
(state) (pcase state
|
||
|
|
(`(leaf . ,_attrs) (bufferize-leaf state))
|
||
|
|
((pred atom) state)
|
||
|
|
(`(,_key . ,(pred atom)) state)
|
||
|
|
((pred list) (mapcar #'bufferize-state state))))
|
||
|
|
(bufferize-leaf
|
||
|
|
(leaf) (pcase-let* ((`(leaf . ,attrs) leaf)
|
||
|
|
((map parameters buffer) attrs)
|
||
|
|
((map burly-url) parameters)
|
||
|
|
(`(,_buffer-name . ,buffer-attrs) buffer)
|
||
|
|
(new-buffer (burly-url-buffer burly-url)))
|
||
|
|
(setf (map-elt attrs 'buffer) (cons new-buffer buffer-attrs))
|
||
|
|
(cons 'leaf attrs))))
|
||
|
|
(if-let ((leaf-pos (cl-position 'leaf state)))
|
||
|
|
;; A one-window frame: the elements following `leaf' are that window's params.
|
||
|
|
(append (cl-subseq state 0 leaf-pos)
|
||
|
|
(bufferize-leaf (cl-subseq state leaf-pos)))
|
||
|
|
;; Multi-window frame.
|
||
|
|
(bufferize-state state))))
|
||
|
|
|
||
|
|
;;;;; Bookmarks
|
||
|
|
|
||
|
|
(defun burly--bookmark-window-state-hack (&optional _)
|
||
|
|
"Put window state from `burly--window-state'.
|
||
|
|
This function is to be called in `bookmark-after-jump-hook' to
|
||
|
|
work around `bookmark--jump-via's calling a buffer-display
|
||
|
|
function which changes the window configuration after
|
||
|
|
`burly--windows-set' has set it. This function removes itself
|
||
|
|
from the hook."
|
||
|
|
(unwind-protect
|
||
|
|
(progn
|
||
|
|
(cl-assert burly--window-state)
|
||
|
|
(window-state-put burly--window-state (frame-root-window)))
|
||
|
|
(setf bookmark-after-jump-hook (delete #'burly--bookmark-window-state-hack bookmark-after-jump-hook)
|
||
|
|
burly--window-state nil)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun burly-bookmark-handler (bookmark)
|
||
|
|
"Handler function for Burly BOOKMARK."
|
||
|
|
(let ((previous-name burly-opened-bookmark-name))
|
||
|
|
;; Set opened bookmark name before actually opening it so that the
|
||
|
|
;; tabs-mode advice functions can use it beforehand.
|
||
|
|
(setf burly-opened-bookmark-name (car bookmark))
|
||
|
|
(condition-case err
|
||
|
|
(burly-open-url (alist-get 'url (bookmark-get-bookmark-record bookmark)))
|
||
|
|
(error (setf burly-opened-bookmark-name previous-name)
|
||
|
|
(signal (car err) (cdr err))))))
|
||
|
|
|
||
|
|
(defun burly--bookmark-record-url (record)
|
||
|
|
"Return a URL for bookmark RECORD."
|
||
|
|
(cl-assert record)
|
||
|
|
(pcase-let* ((`(,name . ,props) record)
|
||
|
|
(print-length nil) ; Important!
|
||
|
|
(query (cl-loop for prop in props
|
||
|
|
;; HACK: Remove unreadable values from props.
|
||
|
|
do (cl-loop for value in-ref (cdr prop)
|
||
|
|
when (or (bufferp value))
|
||
|
|
do (setf value nil))
|
||
|
|
collect (list (car prop) (prin1-to-string (cdr prop)))))
|
||
|
|
(filename (concat (url-hexify-string name) "?" (url-build-query-string (remove nil query)))))
|
||
|
|
(url-recreate-url (url-parse-make-urlobj "emacs+burly+bookmark" nil nil nil nil
|
||
|
|
filename nil nil 'fullness))))
|
||
|
|
|
||
|
|
(defun burly--bookmark-url-buffer (urlobj)
|
||
|
|
"Return buffer for bookmark specified by URLOBJ.
|
||
|
|
URLOBJ should be a URL object as returned by
|
||
|
|
`url-generic-parse-url'."
|
||
|
|
(pcase-let* ((`(,path . ,query-string) (url-path-and-query urlobj))
|
||
|
|
(query (url-parse-query-string query-string))
|
||
|
|
;; Convert back to alist.
|
||
|
|
(props (cl-loop for prop in query
|
||
|
|
for key = (intern (car prop))
|
||
|
|
for value = (pcase key
|
||
|
|
('handler (intern (cadr prop)))
|
||
|
|
('help-args (read (cadr prop)))
|
||
|
|
('help-fn (ignore-errors
|
||
|
|
;; NOTE: Due to changes in help-mode.el which serialize natively
|
||
|
|
;; compiled subrs in the bookmark record, which cannot be read
|
||
|
|
;; back (which actually break the entire bookmark system when
|
||
|
|
;; such a record is saved in the bookmarks file), we have to
|
||
|
|
;; workaround a failure to read here. See bug#56643.
|
||
|
|
(read (cadr prop))))
|
||
|
|
('position (cl-parse-integer (cadr prop)))
|
||
|
|
(_ (read (cadr prop))))
|
||
|
|
collect (cons key value)))
|
||
|
|
(record (cons path props)))
|
||
|
|
(cl-labels ((decode (element)
|
||
|
|
(cl-typecase element
|
||
|
|
(string (decode-coding-string element 'utf-8-unix))
|
||
|
|
(proper-list (mapcar #'decode element))
|
||
|
|
(cons (cons
|
||
|
|
(decode (car element))
|
||
|
|
(decode (cdr element))))
|
||
|
|
(t element))))
|
||
|
|
;; Decode all strings in record with UTF-8.
|
||
|
|
;; NOTE: If we stop using URLs in the future, maybe this won't be needed.
|
||
|
|
(setf record (decode record)))
|
||
|
|
(save-window-excursion
|
||
|
|
(condition-case err
|
||
|
|
(bookmark-jump record)
|
||
|
|
(error (delay-warning 'burly (format "Error while opening bookmark: ERROR:%S RECORD:%S" err record))))
|
||
|
|
(current-buffer))))
|
||
|
|
|
||
|
|
(defun burly-bookmark-names ()
|
||
|
|
"Return list of all Burly bookmark names."
|
||
|
|
(cl-loop for bookmark in bookmark-alist
|
||
|
|
for (_name . params) = bookmark
|
||
|
|
when (equal #'burly-bookmark-handler (alist-get 'handler params))
|
||
|
|
collect (car bookmark)))
|
||
|
|
|
||
|
|
;;;;; Org buffers
|
||
|
|
|
||
|
|
;; We only require Org when compiling the file. At runtime, Org will
|
||
|
|
;; be loaded before we call any of its functions, because we load the
|
||
|
|
;; Org file into a buffer first, which activates `org-mode'.
|
||
|
|
|
||
|
|
(eval-when-compile
|
||
|
|
(require 'org))
|
||
|
|
|
||
|
|
(declare-function org-before-first-heading-p "org")
|
||
|
|
(declare-function org-back-to-heading "org")
|
||
|
|
(declare-function org-find-olp "org")
|
||
|
|
(declare-function org-tree-to-indirect-buffer "org")
|
||
|
|
(declare-function org-narrow-to-subtree "org")
|
||
|
|
(declare-function org-heading-components "org")
|
||
|
|
(declare-function org-up-heading-safe "org")
|
||
|
|
|
||
|
|
(defun burly--org-mode-buffer-url (buffer)
|
||
|
|
"Return URL for Org BUFFER."
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(cl-assert (or (buffer-file-name buffer)
|
||
|
|
(buffer-file-name (buffer-base-buffer buffer)))
|
||
|
|
nil "Buffer has no file name: %s" buffer)
|
||
|
|
(let* ((narrowed (buffer-narrowed-p))
|
||
|
|
(indirect (buffer-base-buffer buffer))
|
||
|
|
(top-olp
|
||
|
|
;; For narrowing purposes, start with the heading at the top of the buffer.
|
||
|
|
(when (buffer-narrowed-p)
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (point-min))
|
||
|
|
;; `org-get-outline-path' replaces links in headings with their
|
||
|
|
;; descriptions, which prevents using them in regexp searches.
|
||
|
|
(when (org-heading-components)
|
||
|
|
(org-with-wide-buffer
|
||
|
|
(nreverse (cl-loop collect (substring-no-properties (nth 4 (org-heading-components)))
|
||
|
|
while (org-up-heading-safe))))))))
|
||
|
|
(point-olp
|
||
|
|
(when (ignore-errors (org-heading-components))
|
||
|
|
(org-with-wide-buffer
|
||
|
|
(nreverse (cl-loop collect (substring-no-properties (nth 4 (org-heading-components)))
|
||
|
|
while (org-up-heading-safe))))))
|
||
|
|
(pos (point))
|
||
|
|
(relative-pos (when top-olp
|
||
|
|
(- (point) (save-excursion
|
||
|
|
(org-back-to-heading)
|
||
|
|
(point)))))
|
||
|
|
(print-length nil) ; Important!
|
||
|
|
(query (list (list "pos" pos)
|
||
|
|
(when top-olp
|
||
|
|
(list "top-olp" (prin1-to-string top-olp)))
|
||
|
|
(when point-olp
|
||
|
|
(list "point-olp" (prin1-to-string point-olp)))
|
||
|
|
(when relative-pos
|
||
|
|
(list "relative-pos" relative-pos))
|
||
|
|
(when indirect
|
||
|
|
(list "indirect" "t"))
|
||
|
|
(when narrowed
|
||
|
|
(list "narrowed" "t"))))
|
||
|
|
(buffer-file (or (buffer-file-name buffer)
|
||
|
|
(buffer-file-name (buffer-base-buffer buffer))))
|
||
|
|
(filename (concat buffer-file "?" (url-build-query-string (remove nil query)))))
|
||
|
|
(url-recreate-url (url-parse-make-urlobj "emacs+burly+file" nil nil nil nil
|
||
|
|
filename nil nil 'fullness)))))
|
||
|
|
|
||
|
|
(cl-defun burly-follow-url-org-mode (&key buffer query)
|
||
|
|
"In BUFFER, jump to heading and position from QUERY, and return a buffer.
|
||
|
|
If QUERY specifies that the buffer should be indirect, a new,
|
||
|
|
indirect buffer is returned. Otherwise BUFFER is returned."
|
||
|
|
;; `pcase's map support uses `alist-get', which does not work with string keys
|
||
|
|
;; unless its TESTFN arg is bound to, e.g. `equal', but `map-elt' has deprecated
|
||
|
|
;; its TESTFN arg, and there's no way to pass it or bind it when using `pcase'
|
||
|
|
;; anyway. So we rebind `alist-get' to a function that uses `assoc-string'.
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(cl-letf (((symbol-function 'alist-get)
|
||
|
|
(lambda (key alist &optional _default _remove _testfn)
|
||
|
|
;; Only the first value in the list of values is returned, so multiple
|
||
|
|
;; values are not supported. I don't expect this to be a problem...
|
||
|
|
(cadr (assoc-string key alist)))))
|
||
|
|
(pcase-let* (((map ("pos" pos)
|
||
|
|
("indirect" indirect)
|
||
|
|
("narrowed" narrowed)
|
||
|
|
("top-olp" top-olp)
|
||
|
|
("point-olp" point-olp)
|
||
|
|
("relative-pos" relative-pos))
|
||
|
|
query)
|
||
|
|
(heading-pos (when top-olp
|
||
|
|
(org-find-olp (read top-olp) 'this-buffer))))
|
||
|
|
(widen)
|
||
|
|
(if heading-pos
|
||
|
|
(goto-char heading-pos)
|
||
|
|
(goto-char (string-to-number pos)))
|
||
|
|
(cond (indirect (org-tree-to-indirect-buffer))
|
||
|
|
(narrowed (progn
|
||
|
|
(org-narrow-to-subtree)
|
||
|
|
(goto-char (org-find-olp (read point-olp) 'this-buffer)))))
|
||
|
|
(when (and heading-pos relative-pos)
|
||
|
|
(forward-char (string-to-number relative-pos)))
|
||
|
|
(current-buffer)))))
|
||
|
|
|
||
|
|
;;;; Footer
|
||
|
|
|
||
|
|
(provide 'burly)
|
||
|
|
|
||
|
|
;;; burly.el ends here
|