;;; 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) ;;; replace the original key-binding (define-key ctl-x-r-map (vector ?l) #'blist-list-bookmarks) ;;; Customizations ;;;; 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 "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))) (location (bookmark-location element))) ;; replace repeating parts (cond ((and handler-name (string-match "\\([^z-a]+\\)-jump" handler-name)) (setq handler-name (replace-regexp-in-string "^durand-" "" (replace-regexp-in-string "-bookmark$" "" (match-string 1 handler-name)))))) ;; take case of file extensions (cond ((and (null handler-name) location (string-match "\\.\\([^.]+\\)\\'" location)) (setq handler-name (match-string 1 location)))) (cond (handler-name (cond ((<= (length handler-name) 3) (upcase handler-name)) ((capitalize handler-name)))))))) (setq blist-automatic-filter-groups #'ilist-automatic-group-durand) ;;; 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. ;;;; 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)) ;;;; 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") (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://wmail1.cc.ntu.edu.tw/rc/?_task=mail&_mbox=INBOX" "(External) NTU mail") (cons "https://dictionary.christian-steinert.de/#home" "(External) tibdict") ;; "https://wmail1.cc.ntu.edu.tw/index.php?url=https%3A%2F%2Fwmail1.cc.ntu.edu.tw%2F" (cons "https://cool.ntu.edu.tw/courses/7680" "(External) cool ITA") )) (provide 'bookmark-conf) ;;; bookmark-conf.el ends here