path: root/bookmark-conf.el

;;; bookmark-conf.el --- My configurations for bookmark  -*- lexical-binding: t; -*-

;; Copyright (C) 2021  Durand

;; Author: Durand <mmemmew@gmail.com>
;; 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:

;; 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

;;;; 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))
           (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))))
      (cond
       (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.

;;;; 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