460 lines
20 KiB
EmacsLisp
460 lines
20 KiB
EmacsLisp
;;; space-doc.el --- Spacemacs documentation minor mode.
|
|
;;
|
|
;; Copyright (c) 2012-2017 Sylvain Benner & Contributors
|
|
;;
|
|
;; Author: Sylvain Benner <sylvain.benner@gmail.com>
|
|
;; URL: https://github.com/syl20bnr/spacemacs
|
|
;;
|
|
;; This file is not part of GNU Emacs.
|
|
;;
|
|
;; Description:
|
|
;; This package provides:
|
|
;; - `space-doc-mode' - buffer local minor mode
|
|
;; for viewing the Spacemacs documentation files.
|
|
;; The mode hides org meta tags to improve readability.
|
|
;; - `org-mode' link-type "https" that opens the local
|
|
;; copies of the Spacemacs documentation files with
|
|
;; `spacemacs/view-org-file' and supports GitHub style
|
|
;; heading links.
|
|
;;
|
|
;; For example, the link:
|
|
;; https://github.com/syl20bnr/spacemacs/blob/develop/layers/org/README.org#links
|
|
;; Will be handled similary to as if it was:
|
|
;; file:~/.emacs.d/layers/org/README.org::*links
|
|
;; Also the `space-doc' mode will be applied.
|
|
|
|
;;; License: GPLv3
|
|
;;; Code:
|
|
(require 'face-remap)
|
|
(require 'org)
|
|
(require 'org-compat)
|
|
(require 'centered-buffer-mode)
|
|
|
|
(defgroup space-doc nil "Minor mode for viewing Spacemacs documentation files."
|
|
:group 'convenience)
|
|
|
|
(define-minor-mode space-doc-mode
|
|
"Buffer local minor mode for viewing Spacemacs documentation files.
|
|
This mode:
|
|
- hides `org-mode' meta tags like #+TITLE: while
|
|
keeping their content visible.
|
|
- Improves emphasized region apparence.
|
|
- enables buffer local link opening with `spacemacs//space-doc-open'.
|
|
=================================================
|
|
= THE MODE IS CUSTOMIZABLE - read Spacemacs FAQ =
|
|
================================================="
|
|
:init-value nil
|
|
:lighter " SD"
|
|
:group 'space-doc
|
|
(spacemacs//space-doc-centered-buffer-mode-goto-origin space-doc-mode)
|
|
(if (derived-mode-p 'org-mode)
|
|
(let ((inhibit-read-only t))
|
|
(spacemacs//space-doc-set-cache +1)
|
|
(dolist (modificator spacemacs-space-doc-modificators-functions)
|
|
(when (member (car modificator)
|
|
spacemacs-space-doc-modificators)
|
|
(funcall (cdr modificator) space-doc-mode))))
|
|
;; Force `org-mode' to replace font text properties with the default ones.
|
|
(unless space-doc-mode (org-font-lock-ensure))
|
|
(message (format "space-doc-mode error:%s isn't an org-mode buffer"
|
|
(buffer-name)))
|
|
(setq space-doc-mode nil)))
|
|
|
|
;; NOTE: Dont forget to update Spacemacs FAQ if you modify this list!
|
|
(defcustom spacemacs-space-doc-modificators
|
|
'(org-indent-mode
|
|
view-mode
|
|
hide-line-numbers
|
|
alternative-emphasis
|
|
alternative-tags-look
|
|
link-protocol
|
|
org-block-line-face-remap
|
|
org-kbd-face-remap
|
|
resize-inline-images)
|
|
"List of `space-doc' modificators."
|
|
:type '(set (const center-buffer-mode)
|
|
(const org-indent-mode)
|
|
(const view-mode)
|
|
(const hide-line-numbers)
|
|
(const alternative-emphasis)
|
|
(const alternative-tags-look)
|
|
(const link-protocol)
|
|
(const org-block-line-face-remap)
|
|
(const org-kbd-face-remap)
|
|
(const resize-inline-images))
|
|
:group 'space-doc)
|
|
|
|
(defcustom spacemacs-space-doc-center-buffer-mode-min-aspect-ratio
|
|
1.7
|
|
"Minimal `frame' aspect ration (`frame-pixel-width' divided by `frame-pixel-height')
|
|
for `spacemacs-centered-buffer-mode' to be automatically enabled.
|
|
NOTE: If `center-buffer-mode' isn't a member of `spacemacs-space-doc-modificators'
|
|
list `spacemacs-centered-buffer-mode' will not be enabled."
|
|
:type 'number
|
|
:group 'space-doc)
|
|
|
|
(defvar spacemacs-space-doc-modificators-functions
|
|
'((center-buffer-mode . spacemacs//space-doc-center-buffer-mode)
|
|
(org-indent-mode . spacemacs//space-doc-org-indent-mode)
|
|
(view-mode . spacemacs//space-doc-view-mode)
|
|
(hide-line-numbers . spacemacs//space-doc-hide-line-numbers)
|
|
(alternative-emphasis . spacemacs//space-doc-alternative-emphasis)
|
|
(alternative-tags-look . spacemacs//space-doc-alternative-tags-look)
|
|
(link-protocol . spacemacs//space-doc-link-protocol)
|
|
(org-block-line-face-remap . spacemacs//space-doc-org-block-line-face-remap)
|
|
(org-kbd-face-remap . spacemacs//space-doc-org-kbd-face-remap)
|
|
(resize-inline-images . spacemacs//space-doc-resize-inline-images))
|
|
"alist of `space-doc' modificator (tag . function) for `org-mode' buffers.
|
|
The functions work with a current buffer and accept ENABLE(flag) argument.
|
|
If the argument has non-nil value - enable the modifications introduced
|
|
by the function. Otherwise - disable. The tags used in `spacemacs-space-doc-modificators'")
|
|
|
|
(defun spacemacs//space-doc-centered-buffer-mode-goto-origin (flag)
|
|
"Switch to the origin buffer if `spacemacs-centere-buffer-mode' is
|
|
enabled. Set the value of `space-doc-mode' variable in the origin
|
|
buffer to FLAG."
|
|
(when spacemacs-centered-buffer-mode
|
|
(let ((old-flag space-doc-mode))
|
|
(spacemacs-centered-buffer-mode -1)
|
|
(setq space-doc-mode old-flag))))
|
|
|
|
(defun spacemacs//space-doc-center-buffer-mode (&optional flag)
|
|
"Enable `spacemacs-centered-buffer-mode' if flag is non nil, disable it otherwise.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(when (and flag
|
|
(not spacemacs-centered-buffer-mode)
|
|
(>= (/ (* (frame-pixel-width) 1.0) (frame-pixel-height))
|
|
spacemacs-space-doc-center-buffer-mode-min-aspect-ratio))
|
|
;; `spacemacs-centered-buffer-mode' is heavy so it's better to make if deferred.
|
|
;; Also it has to be run when the `window-body-width' is properly calculated.
|
|
(run-with-idle-timer 0 nil 'spacemacs-centered-buffer-mode))
|
|
(spacemacs-centered-buffer-mode -1))
|
|
|
|
(defun spacemacs//space-doc-org-indent-mode (&optional flag)
|
|
"Enable `org-indent-mode' if flag is non nil, disable it otherwise.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(org-indent-mode (if flag 1 -1)))
|
|
|
|
(defun spacemacs//space-doc-view-mode (&optional flag)
|
|
"Enable `view-mode' if flag is non nil, disable it otherwise.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(view-mode (if flag 1 -1)))
|
|
|
|
(cl-defstruct spacemacs--space-doc-cache-struct
|
|
marker-face
|
|
btn-marker-face
|
|
kbd-marker)
|
|
|
|
(defvar-local spacemacs--space-doc-cache nil
|
|
"Global variable of struct `spacemacs-space-doc-cache-struct'.
|
|
It is set by `spacemacs//space-doc-set-cache'.")
|
|
|
|
(defun spacemacs//space-doc-set-cache (&optional flag)
|
|
"Set `spacemacs--space-doc-cache'.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(setq spacemacs--space-doc-cache
|
|
(if flag
|
|
(let* ((kbd-bg (or (face-background 'org-kbd)
|
|
(face-background 'region)
|
|
'unspecified))
|
|
(table-bg (or (face-background 'org-table)
|
|
(face-background 'default)
|
|
'unspecified))
|
|
(marker-face
|
|
`(:inherit org-table
|
|
:foreground ,table-bg))
|
|
(btn-marker-face
|
|
`(:inherit org-kbd
|
|
:distant-foreground ,kbd-bg
|
|
:foreground ,kbd-bg))
|
|
(kbd-marker
|
|
(dolist (el org-emphasis-alist)
|
|
(when (member 'org-kbd el)
|
|
(return (car el))))))
|
|
(make-spacemacs--space-doc-cache-struct
|
|
:marker-face marker-face
|
|
:btn-marker-face btn-marker-face
|
|
:kbd-marker kbd-marker)))))
|
|
|
|
(defun spacemacs//space-doc-hide-line-numbers (&optional enable)
|
|
"If ENABLE is non-nil then toggle off the line numbers.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(if enable
|
|
(spacemacs/toggle-line-numbers-off)
|
|
(when dotspacemacs-line-numbers
|
|
(spacemacs/toggle-line-numbers-on))))
|
|
|
|
(defun spacemacs//space-doc-org-do-emphasis-faces-advice (found)
|
|
"If FOUND has non-nil value then modify emphasized regions
|
|
appearances in the current buffer. The function uses
|
|
`match-data' set by `org-do-emphasis-faces' function."
|
|
;; `org-do-emphasis-faces' returns non-nil value when it
|
|
;; found a region to emphasize.
|
|
(when (and space-doc-mode
|
|
found
|
|
(not (and
|
|
(match-string 4)
|
|
(string-empty-p
|
|
(replace-regexp-in-string "\\*+"
|
|
""
|
|
(match-string 4))))))
|
|
(spacemacs//space-doc-emphasis-region
|
|
(match-beginning 2)
|
|
(match-end 2)))
|
|
found)
|
|
|
|
(defun spacemacs//space-doc-advice-org-do-emphasis-faces (&optional enable)
|
|
"Advise org-do-emphasis-faces.
|
|
If ENABLE is non-nil, add advice `org-do-emphasis-faces' function with
|
|
`spacemacs//space-doc-org-do-emphasis-faces-advice'.
|
|
NOTE: `org-do-emphasis-faces' is lazy and will emphasize only part of the
|
|
current buffer so piggybacking it should be pretty performant solution."
|
|
(when enable
|
|
(advice-add 'org-do-emphasis-faces
|
|
:after
|
|
#'spacemacs//space-doc-org-do-emphasis-faces-advice)))
|
|
|
|
(defun spacemacs//space-doc-add-region-edge-text-property (begin end property &optional face)
|
|
"Add text PROPERTY to the first and last character of the BEGIN END text region
|
|
with `add-text-properties' or if FACE has non-nil value `add-face-text-property'."
|
|
(let ((edge-sub-regs (list (list (1+ begin) begin)
|
|
(list (1- end) end))))
|
|
(dolist (edge-sub-reg edge-sub-regs)
|
|
(funcall (if face
|
|
'add-face-text-property
|
|
'add-text-properties)
|
|
(car edge-sub-reg)
|
|
(cadr edge-sub-reg)
|
|
property))))
|
|
|
|
(defun spacemacs//space-doc-emphasis-region (begin end)
|
|
"Emphasis region based on its leading character.
|
|
The character should be one of the markers from `org-emphasis-alist'."
|
|
(let ((kbd-face (spacemacs--space-doc-cache-struct-btn-marker-face
|
|
spacemacs--space-doc-cache))
|
|
(marker-face (spacemacs--space-doc-cache-struct-marker-face
|
|
spacemacs--space-doc-cache)))
|
|
(if (string= (buffer-substring-no-properties begin
|
|
(1+ begin))
|
|
(spacemacs--space-doc-cache-struct-kbd-marker
|
|
spacemacs--space-doc-cache))
|
|
(spacemacs//space-doc-add-region-edge-text-property begin end kbd-face t)
|
|
(if (save-excursion
|
|
(goto-char begin)
|
|
(beginning-of-line)
|
|
(looking-at-p org-table-any-line-regexp))
|
|
;; If inside table.
|
|
(spacemacs//space-doc-add-region-edge-text-property begin end marker-face t)
|
|
(spacemacs//space-doc-add-region-edge-text-property
|
|
begin
|
|
end
|
|
'(invisible spacemacs--space-doc-invisible-marker))))))
|
|
|
|
(defun spacemacs//space-doc-alternative-emphasis (&optional enable)
|
|
"Emphasis overlays.
|
|
If ENABLE is non-nil, change the look of regions which have already
|
|
been emphasized by `org-do-emphasis-faces' in the current buffer.
|
|
Otherwise revert to the normal look.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(if enable
|
|
(progn
|
|
(spacemacs//space-doc-advice-org-do-emphasis-faces enable)
|
|
(add-to-invisibility-spec 'spacemacs--space-doc-invisible-marker)
|
|
(dolist (emphasized-region
|
|
(spacemacs//space-doc-find-regions-by-text-property
|
|
'org-emphasis t))
|
|
(spacemacs//space-doc-emphasis-region
|
|
(car emphasized-region)
|
|
(cadr emphasized-region))))
|
|
(remove-from-invisibility-spec 'spacemacs--space-doc-invisible-marker)))
|
|
|
|
(defun spacemacs//space-doc-org-kbd-face-remap (&optional enable)
|
|
"Remove boxes from key bindings.
|
|
If ENABLE is non-nil, removes boxes from the `org-kbd'face in the current
|
|
`org-mode' buffer.
|
|
Otherwise, reverts them to default.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(if enable
|
|
(set (make-local-variable
|
|
'spacemacs--space-doc-org-kbd-face-remap-cookie)
|
|
(face-remap-add-relative 'org-kbd
|
|
`(:box nil)))
|
|
(when (bound-and-true-p spacemacs--space-doc-org-kbd-face-remap-cookie)
|
|
(face-remap-remove-relative
|
|
spacemacs--space-doc-org-kbd-face-remap-cookie))))
|
|
|
|
(defun spacemacs//space-doc-resize-inline-images (&optional enable)
|
|
"Resize inline images.
|
|
If ENABLE is non nil then resize inline images.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
;; resizing is always performed even when the image is smaller
|
|
;; so we don't resize in README.org buffers for now
|
|
(let ((org-image-actual-width
|
|
(and enable
|
|
(not (string-match-p ".*README.org\\'" (buffer-file-name)))
|
|
600)))
|
|
(org-display-inline-images)))
|
|
|
|
(defun spacemacs//space-doc-tags-fontify (startish endish &optional verbose)
|
|
"Fontify `org-mode' tags in the fuzzy region that starts
|
|
before STARTISH and end after ENDISH. VERBOSE ignored."
|
|
;; TODO add more types of tags or meta-line if needed.
|
|
(let ((invisible-org-meta-tags-list
|
|
`(;; Hide TITLE tag.
|
|
"\\([ \t]*\\#\\+TITLE\\:\[ \t]*\\)"
|
|
;; Hide CAPTION logo meta line.
|
|
"\\(\n.*\\#\\+CAPTION\\:.*\\)"
|
|
;; Hide PROPERTIES lines.
|
|
"\\(\n.*\\:PROPERTIES\\:.*\\)"
|
|
"\\(\n.*\\:CUSTOM_ID\\:.*\\)"
|
|
"\\(\n.*\\:END\\:.*\\)"
|
|
;; Hide TOC-ORG tag and spaces before it.
|
|
;; Use modified `toc-org-toc-org-regexp' because
|
|
;; the original one matches whole string.
|
|
,(concat "\\([ \t]*:toc\\([@_][0-9]\\|\\([@_][0-9]"
|
|
"[@_][a-zA-Z]+\\)\\)?:\\($\\|[^ ]*:$\\)\\)")
|
|
;; Hide empty line before #+BEGIN_SRC tag if
|
|
;; background color of the `org-block-begin-line'
|
|
;; face is unspecified.
|
|
,(unless (face-background 'org-block-begin-line)
|
|
"\n\\(\n\\)[ \t]*\\#\\+begin_src.*$")
|
|
;; Hide empty line after #+END_SRC tag if
|
|
;; background color of the `org-block-end-line'
|
|
;; face is unspecified and the next line isn't
|
|
;;an org headline.
|
|
,(unless (face-background 'org-block-end-line)
|
|
"^[ \t]*\\#\\+end_src.*\n\\(\n\\)[^\\*]")))
|
|
(start (save-excursion (goto-char (or startish
|
|
(point-min)))
|
|
(point-at-bol -2)))
|
|
(end (save-excursion (goto-char (or endish
|
|
(point-max)))
|
|
(point-at-eol 2))))
|
|
;; Remove nils.
|
|
(setq invisible-org-meta-tags-list
|
|
(remove nil invisible-org-meta-tags-list))
|
|
;; Make `org-mode' meta tags invisible.
|
|
(dolist (tag invisible-org-meta-tags-list)
|
|
(save-excursion
|
|
(goto-char start)
|
|
(while (re-search-forward tag end t)
|
|
(add-text-properties (match-beginning 1)
|
|
(match-end 1)
|
|
(list 'invisible 'spacemacs--space-doc-invisible-marker)))))))
|
|
|
|
(defun spacemacs//space-doc-font-lock-fontify-region-function (start end &optional verbose)
|
|
"Wrapper around `font-lock-default-fontify-region' function for the buffer local value of
|
|
`font-lock-fontify-region-function'. Makes sure that `font-lock-default-fontify-region'
|
|
text property persist after `org-mode' shenanigans.
|
|
NOTE: Not using `advice-add' because it is global modification.
|
|
FIXME: Find cleaner solution."
|
|
(font-lock-default-fontify-region start end verbose)
|
|
(spacemacs//space-doc-tags-fontify start end verbose))
|
|
|
|
(defun spacemacs//space-doc-alternative-tags-look (&optional enable)
|
|
"Modify meta tag appearance.
|
|
If ENABLE is non-nil, modify `org-mode' meta tags appearance in the current
|
|
buffer.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(if enable
|
|
(setq-local font-lock-fontify-region-function
|
|
'spacemacs//space-doc-font-lock-fontify-region-function)
|
|
(kill-local-variable 'font-lock-fontify-region-function)))
|
|
|
|
(defun spacemacs//space-doc-org-block-line-face-remap (&optional enable)
|
|
"Hide drawers.
|
|
If ENABLE is non-nil, hide text of the code block meta lines in the current
|
|
buffer. If the blocks have background color text won't be masked because it
|
|
makes them look ugly with some themes.
|
|
If ENABLE has nil, revert to the default.
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(if enable
|
|
(let* ((default-bg (or (face-background 'default)
|
|
'unspecified))
|
|
(org-bb-bg (or (face-background 'org-block-begin-line)
|
|
(face-background 'org-meta-line)))
|
|
(hide-bb-text-face `(:inherit org-block-begin-line
|
|
:foreground ,default-bg
|
|
:distant-foreground ,default-bg))
|
|
(org-bn-bg (or (face-background 'org-block-end-line)
|
|
(face-background 'org-meta-line)))
|
|
(hide-bn-text-face `(:inherit org-block-end-line
|
|
:foreground ,default-bg
|
|
:distant-foreground ,default-bg)))
|
|
(unless org-bb-bg
|
|
(set (make-local-variable
|
|
'spacemacs--space-doc-org-block-begin-line-face-remap-cookie)
|
|
(face-remap-add-relative 'org-block-begin-line
|
|
hide-bb-text-face)))
|
|
(unless org-bn-bg
|
|
(set (make-local-variable
|
|
'spacemacs--space-doc-org-block-end-line-face-remap-cookie)
|
|
(face-remap-add-relative 'org-block-end-line
|
|
hide-bn-text-face))))
|
|
(when (bound-and-true-p
|
|
spacemacs--space-doc-org-block-begin-line-face-remap-cookie)
|
|
(face-remap-remove-relative
|
|
spacemacs--space-doc-org-block-begin-line-face-remap-cookie))
|
|
(when (bound-and-true-p
|
|
spacemacs--space-doc-org-block-end-line-face-remap-cookie)
|
|
(face-remap-remove-relative
|
|
spacemacs--space-doc-org-block-end-line-face-remap-cookie))))
|
|
|
|
(defun spacemacs//space-doc-link-protocol (&optional enable)
|
|
"Open HTTPS links in the current buffer.
|
|
If ENABLE is non-nil, use `spacemacs//space-doc-open' to open HTTPS links
|
|
in the current `org-mode' buffer.
|
|
Otherwise open them in the browser (default behavior).
|
|
This functions is aimed to be used with `spacemacs-space-doc-modificators'."
|
|
(if enable
|
|
(progn
|
|
;; Make `space-doc' https link opener buffer local
|
|
;; and enable it only when `space-doc' mode is enabled.
|
|
(make-local-variable 'org-link-types)
|
|
(make-local-variable 'org-link-protocols)
|
|
(org-add-link-type "https" 'spacemacs//space-doc-open))
|
|
(kill-local-variable 'org-link-types)
|
|
(kill-local-variable 'org-link-protocols))
|
|
;; Trigger `org-mode' internal updates.
|
|
;; NOTE: might be unnecessary.
|
|
(org-add-link-type nil))
|
|
|
|
(defun spacemacs//space-doc-open (path)
|
|
"Open PATH link.
|
|
If PATH argument is a link to an .org file that is located in the Spacemacs
|
|
GitHub repository then visit the local copy of the file with
|
|
`spacemacs/view-org-file'.
|
|
Open all other links with `browse-url'."
|
|
(let ((git-url-root-regexp
|
|
(concat "\\/\\/github\\.com\\/syl20bnr\\/spacemacs\\/blob"
|
|
"\\/[^/]+\\/\\(.*\\.org\\)\\(\\#.*\\)?")))
|
|
(if (string-match git-url-root-regexp path)
|
|
(spacemacs/view-org-file (concat spacemacs-start-directory
|
|
(match-string 1 path))
|
|
(or (match-string 2 path)
|
|
"^")
|
|
'subtree)
|
|
(browse-url (concat "https://" path)))))
|
|
|
|
(defun spacemacs//space-doc-find-regions-by-text-property
|
|
(property value &optional start end)
|
|
"Return a list of pairs (region-beginning region-end) in
|
|
the current buffer. If START or END has non-nil value - use them as
|
|
boundaries.
|
|
NOTE: It can find only fontified regions."
|
|
(let ((p-min (or start (point-min)))
|
|
(p-max (or end (point-max)))
|
|
(r-end nil)
|
|
(ret (list)))
|
|
(while (not (= p-min p-max))
|
|
(setq p-min (or (text-property-any p-min p-max property value)
|
|
(point-max))
|
|
r-end (or (text-property-not-all p-min p-max property value)
|
|
(point-max))
|
|
ret (append ret (unless (= p-min r-end)
|
|
(list(list p-min r-end))))
|
|
p-min r-end))
|
|
ret))
|
|
|
|
(provide 'space-doc)
|
|
;;; space-doc.el ends here.
|