;;; bookmark-conf.el --- My configurations for bookmark -*- lexical-binding: t; -*- ;; Copyright (C) 2021 Durand ;; Author: Durand ;; 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 . ;;; Commentary: ;; My configurations for bookmarks. ;;; Code: (require 'bookmark) (autoload 'use-package "basic") ;; dependency of blist (use-package "ilist" 'ilist) (require 'ilist) (use-package "blist" 'blist) (require 'blist) ;;; Shorter buffer name (setq blist-buffer-name "*Bookmarks*") ;;; replace the original key-binding (define-key ctl-x-r-map (vector ?l) #'blist-list-bookmarks) ;;; Customizations ;;;; Pixel-level precision ;; My bookmarks contain entries with name composed of non-Latin ;; characters, so pixel-level precision is critical in the correct ;; display. (setq ilist-pixel-precision t) ;;;; No strange fringe indicators (setq bookmark-set-fringe-mark nil) ;;;; HL-LINE (add-hook 'blist-mode-hook #'hl-line-mode) ;;;; I am not an expert ;; I prefer not being an expert now, as deleting bookmarks is quite ;; dangerous for me, as I start to depend my workflow on these ;; bookmarks. It might be difficult to restore the bookmark of a PDF ;; file deeply buried somewhere inside my file system, if I ;; accidentally delete it. (setq blist-expert nil) ;;;; Discard empty groups (setq blist-discard-empty-p t) ;;;; I love cycling (setq blist-movement-cycle t) ;;;; Filter groups ;;;;; Features (setq blist-filter-features (list 'auto 'manual)) ;;;;; Fixed groups ;; Now that I have automatic groups, I only need some of these manual ;; groups to keep certain groups in the order I prefer, and placed at ;; the top of the list. (setq blist-filter-groups (list (cons "बोधिचर्यावतारस्य" #'blist-bodhicaryAvatAra-p) (cons "PDF" #'blist-pdf-p) (cons "C" #'blist-c-p) (cons "Gnus" #'blist-gnus-p) (cons "ELisp" #'blist-elisp-p) (cons "Eshell" #'blist-eshell-p))) ;;;;; Automatic groups (ilist-dag "durand" blist-filter-default-label #'blist-filter-sorter-default (save-match-data (let* ((handler (bookmark-get-handler element)) (handler-name (and handler (format "%S" handler))) (handler-type (cond ((functionp #'bookmark-type-from-full-record) (bookmark-type-from-full-record element)))) (location (bookmark-location element)) (capitalize-p t)) ;; replace repeating parts (cond ((and handler-name (string-match "\\([^z-a]+\\)-jump" handler-name)) (setq handler-name (replace-regexp-in-string "^durand-" "" (match-string 1 handler-name))))) (setq handler-name (and (stringp handler-name) (replace-regexp-in-string (rx "-bookmark" (zero-or-one "-handler") eos) "" handler-name))) ;; Tramp bookmarks (cond ((and (stringp location) (not (string= location "")) (file-remote-p location)) (setq handler-name (concat "Tramp - " (format "%s%s" (cond ((file-remote-p location 'user) (concat (file-remote-p location 'user) "@")) ("")) (cond ((file-remote-p location 'host)) (""))))) (setq capitalize-p nil))) ;; take case of file extensions (cond ((and (null handler-name) location (string-match "\\.\\([^.]+\\)\\'" location)) (setq handler-name (match-string 1 location)) (let ((new-location location)) (while (and handler-name (durand-member handler-name (list "gpg") #'string=)) (setq new-location (substring new-location nil (max 0 (1- (match-beginning 1))))) (cond ((string-match "\\.\\([^.]+\\)\\'" new-location) (setq handler-name (match-string 1 new-location))) ((setq handler-name nil))))))) (cond (handler-type) (handler-name (cond ((<= (length handler-name) 3) (upcase handler-name)) (capitalize-p (capitalize handler-name)) (handler-name))))))) (setq blist-automatic-filter-groups #'ilist-automatic-group-durand) ;;; Don't make numbered backups (setq bookmark-version-control 'never) ;;; More bookmark groups ;; Some of these are not needed anymore, but I still keep them here as ;; a reference. Or maybe I just don't want to delete them. ;;;; बोधिचर्यावतारः group ;; I gathered some bookmarks related to this important text, so I ;; decide to put them in a dedicated group. (blist-define-criterion "bodhicaryAvatAra" "बोधिचर्यावतारस्य" (or (string-match-p "बोधिचर्यावतारस्य" (bookmark-location bookmark)) (string-match-p "बोधिचर्यावतार" (bookmark-name-from-full-record bookmark)))) ;;;; Gnus group ;; There seems to be only two GNUS bookmark handlers (or one?) (blist-define-criterion "gnus" "Gnus" (memq (bookmark-get-handler bookmark) (list #'gnus-summary-bookmark-jump #'gnus-bookmark-jump))) ;;;; EWW group (blist-define-criterion "eww" "EWW" (eq (bookmark-get-handler bookmark) 'durand-eww-bookmark-jump)) ;;;; Info group (blist-define-criterion "info" "Info" (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump)) ;;;; PDF group (blist-define-criterion "pdf" "PDF" (eq (bookmark-get-handler bookmark) 'pdf-view-bookmark-jump-handler)) ;; This is added in Emacs 29. (put 'pdf-view-bookmark-jump-handler 'bookmark-handler-type "PDF") ;;;; Org group (defvar org-directory) (blist-define-criterion "org" "Org" (let ((location (blist-get-location bookmark))) (or (string-match-p "\\.org$" location) (and (file-directory-p (or org-directory "/non-existing")) (file-in-directory-p location org-directory))))) ;;;; C group (blist-define-criterion "c" "C" ;; `rx' is a macro, so that we don't have to compute the regular ;; expression every time we match a line. (string-match-p (rx (or (seq ".c" (zero-or-one "pp") eos) (seq ".h" (zero-or-one "pp") eos))) (blist-get-location bookmark))) ;;;; ELisp group (blist-define-criterion "elisp" "ELisp" (string-match-p "\\.el$" (blist-get-location bookmark))) ;;;; External group (blist-define-criterion "external" "External" (eq (bookmark-get-handler bookmark) #'durand-external-jump)) ;;; Fit annotations buffer to window (autoload 'durand-fit-window-to-buffer-with-max "common") (defun durand-bookmark-jump-fit-to-window (&rest _args) "Fit the annotations buffer to its window, if needed. ARGS are ignored." (let ((window (get-buffer-window "*Bookmark Annotation*"))) (cond ((and window (windowp window) (window-live-p window)) (durand-fit-window-to-buffer-with-max window))))) (advice-add #'bookmark-jump :after #'durand-bookmark-jump-fit-to-window) ;;; Display of the list (cond ((assoc blist-buffer-name display-buffer-alist #'string-match-p) (setcdr (assoc blist-buffer-name display-buffer-alist #'string-match-p) '((display-buffer-same-window)))) (t (add-to-list 'display-buffer-alist `(,(rx bos (eval blist-buffer-name) eos) (display-buffer-same-window))))) ;;; Preserve annotation when overriding it (defun durand-bookmark-set-preserve-annotation-advice (old-function prompt name overwrite-or-push) "Preserve the annotation of the old bookmark if we overwrite it. OLD-FUNCTION should be `bookmark-set-internal'. PROMPT, NAME are passed to `bookmark-set-internal'. If OVERWRITE-OR-PUSH is non-nil, we set the overriding new bookmark to have the same annotations as the old bookmark, if any." ;; if we are not overwriting, we do not modify the behaviour (cond ((or (not overwrite-or-push) (eq overwrite-or-push 'push)) (funcall old-function prompt name overwrite-or-push)) ;; This temporary record only serves the purpose of providing a ;; default bookmark. ((let* ((temp-record (bookmark-make-record)) (defaults (bookmark-prop-get temp-record 'defaults)) (default (cond ((consp defaults) (car defaults)) (defaults))) (name (or name (read-from-minibuffer (format-prompt prompt default) nil bookmark-minibuffer-read-name-map nil nil defaults))) (name (cond ((string= name "") default) (name))) (bookmark (bookmark-get-bookmark name t)) (annotation (cond (bookmark (bookmark-get-annotation bookmark))))) (funcall old-function prompt name overwrite-or-push) (bookmark-set-annotation bookmark annotation))))) (advice-add #'bookmark-set-internal :around #'durand-bookmark-set-preserve-annotation-advice) ;;; Bookmarks for external browsers (defun durand-set-external-bookmark (url name) "Set a bookmark NAME storing URL. This will be opened by the function `browse-url-default-browser'." (bookmark-store name (list (cons 'location url) (cons 'handler #'durand-external-jump)) nil)) (autoload 'browse-url-default-browser "browse-url") ;; This is added in Emacs 29. (put 'durand-external-jump 'bookmark-handler-type "External") (defun durand-external-jump (bookmark) "Jump to the external BOOKMARK. BOOKMARK should be set by `durand-set-external-bookmark'." (let* ((location (bookmark-prop-get bookmark 'location)) (reporter (make-progress-reporter (format "Opening %s..." location)))) (browse-url-default-browser location) (progress-reporter-done reporter))) (mapc (lambda (cons-cell) (durand-set-external-bookmark (car cons-cell) (cdr cons-cell))) (list (cons "https://www.youtube.com" "(External) YouTube") (cons "https://www.gmail.com" "(External) GMail") (cons "https://www.facebook.com" "(External) Facebook") (cons "https://protesilaos.com" "(External) prot") (cons "https://dictionary.christian-steinert.de/#home" "(External) tibdict") (cons "https://cool.ntu.edu.tw" "(External) cool ITA") ;; "https://wmail1.cc.ntu.edu.tw/index.php?url=https%3A%2F%2Fwmail1.cc.ntu.edu.tw%2F" (cons "https://ambuda.org/texts/bodhicaryavatara/" "(External) bodhicaryAvatAraH") (cons "https://wmail1.cc.ntu.edu.tw/rc/?_task=mail&_mbox=INBOX" "(External) NTU mail") )) ;;; A much quicker alternative to `bookmark-write-file' (defun durand-bookmark-write-file (file) "Write `bookmark-alist' to FILE. Modified by Durand to use `print' instead of `pp'. -- 2022-07-16 13:09:22.777148" (let ((reporter (make-progress-reporter (format "Saving bookmarks to file %s..." file)))) (with-current-buffer (get-buffer-create " *Bookmarks*") (goto-char (point-min)) (delete-region (point-min) (point-max)) (let ((coding-system-for-write (or coding-system-for-write bookmark-file-coding-system 'utf-8-emacs)) (print-length nil) (print-level nil) ;; See bug #12503 for why we bind `print-circle'. Users ;; can define their own bookmark types, which can result in ;; arbitrary Lisp objects being stored in bookmark records, ;; and some users create objects containing circularities. (print-circle t)) (insert "(") ;; Rather than a single call to `pp' we make one per bookmark. ;; Apparently `pp' has a poor algorithmic complexity, so this ;; scales a lot better. bug#4485. ;; ;; Using print is better. Durand -- 2022-07-16 13:10:25.084726 (dolist (i bookmark-alist) (print i (current-buffer))) (insert ")\n") ;; Make sure the specified encoding can safely encode the ;; bookmarks. If it cannot, suggest utf-8-emacs as default. (with-coding-priority '(utf-8-emacs) (setq coding-system-for-write (select-safe-coding-system (point-min) (point-max) (list t coding-system-for-write)))) (goto-char (point-min)) (bookmark-insert-file-format-version-stamp coding-system-for-write) (let ((version-control (cond ((null bookmark-version-control) nil) ((eq 'never bookmark-version-control) 'never) ((eq 'nospecial bookmark-version-control) version-control) (t t)))) (condition-case nil ;; There was a stretch of time (about 15 years) when we ;; used `write-region' below instead of `write-file', ;; before going back to `write-file' again. So if you're ;; considering changing it to `write-region', please see ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=12507. ;; That bug tells the story of how we first started using ;; `write-region' in 2005... ;; ;; commit a506054af7cd86a63fda996056c09310966f32ef ;; Author: Karl Fogel ;; AuthorDate: Sat Nov 12 20:30:22 2005 +0000 ;; ;; (bookmark-write-file): Don't visit the ;; destination file, just write the data to it ;; using write-region. This is similar to ;; 2005-05-29T08:36:26Z!rms@gnu.org of saveplace.el, ;; but with an additional change to avoid visiting ;; the file in the first place. ;; ;; ...and of how further inquiry led us to investigate (in ;; 2012 and then again in 2020) and eventually decide that ;; matching the saveplace.el change doesn't make sense for ;; bookmark.el. Therefore we reverted to `write-file', ;; which means numbered backups may now be created, ;; depending on `bookmark-version-control' as per above. (write-file file) (file-error (message "Can't write %s" file))) (setq bookmark-file-coding-system coding-system-for-write) (kill-buffer (current-buffer)) (progress-reporter-done reporter)))))) (advice-add #'bookmark-write-file :override #'durand-bookmark-write-file) ;;; Intelligent saving of bookmarks and desktop files (load-config "desktop-conf.el") (defvar durand-saving-bookmarks nil "Non-nil if we are saving bookmarks already.") (defun durand-save-bookmark-or-desktop (&optional arg) "Save bookmarks and/or desktop depending on ARG. If and only if ARG is non-nil, save the desktop file. If and only if ARG is an integer, do not save bookmarks. Below are listed three possible scenarios: 1. ARG = nil: save bookmarks only. 2. ARG = '(4): save both bookmarks and desktop. 3. ARG = integer: save desktop only." (interactive "P") (cond (arg (let ((durand-saving-bookmarks t)) (desktop-save (car desktop-path)) (message "desktop saved")))) (cond ((not (integerp arg)) (bookmark-save)))) (define-key ctl-x-r-map (vector ?s) #'durand-save-bookmark-or-desktop) ;;; Jump to bookmark in a new tab (defun durand-jump-bookmark-new-tab (bookmark) "Jump to BOOKMARK similar to `bookmark-jump'. But this always opens the bookmark in a new tab." (interactive (list (bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark))) (bookmark-jump bookmark #'switch-to-buffer-other-tab)) (define-key tab-prefix-map (vector ?B) #'durand-jump-bookmark-new-tab) (provide 'bookmark-conf) ;;; bookmark-conf.el ends here