Skip to content

Instantly share code, notes, and snippets.

Created March 18, 2020 20:43
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
Hide emphasis markers when point is distant, but leave the space for them, so when they reappear things don't jump. Scale markers down a little if using org-variable-pitch-mode. Extremely rough-cut.
;; Someone needs to lock me up...
(defun org-conceal-emph-pairs (limit)
(org-conceal-pairs limit org-verbatim-re))
(org-conceal-pairs limit org-emph-re)
(defconst org-conceal-vp-scale 0.7) ; as if scaling were a good idea.
(defconst org-conceal-distance 7)
;; Sometimes I'd like to see them, but faintly, like in LightGrey.
(defvar org-conceal-color nil
"Color to use to hide the emphasis markers. Set to nil to use the
background of the default face.")
;; Stupid and undocumented feature, but potentially helpful for
;; debugging: if the org-conceal-color should chance to be a *list*, pick
;; one at random to use. This will use the same one for both sides of an
;; emphasized run of text, but different ones for different runs, so you
;; can see what was considered to pair with what. Like:
;; ("red" "blue" "green" "orange" "magenta" "DarkViolet" "goldenrod")
(defun org-conceal-get-color ()
"Return the color to use to hide the emphasis markers."
(if (atom org-conceal-color) org-conceal-color ; nil is an atom.
(nth (random (length org-conceal-color)) org-conceal-color)))
(defface emptyface
'((t nil))
;; (defun is-face-variable-pitch (facelist)
;; (let ((rv t)
;; (vpf (face-attribute 'variable-pitch :family nil t)))
;; (while (and facelist (eq rv t))
;; (let* ((face (car facelist))
;; (family
;; (cond ((symbolp face)
;; (face-attribute face :family nil t))
;; ((listp face)
;; (plist-get face :family))
;; ;; Doesn't handle lists with :inherit!!
;; )))
;; (cond ((equal family vpf)
;; (setq rv 1))
;; ((and family
;; (not (eq family 'unspecified))) ; Set, but to something else.
;; (setq rv nil))
;; ;; Otherwise (unspecified or nil) do nothing
;; )
;; (setq facelist (cdr facelist))))
;; (not (null rv))))
(defun is-face-variable-pitch (facelist)
;; Nope, no way this works.
;; (equal
;; (face-attribute 'emptyface :family nil
;; (append facelist (list buffer-face-mode-face 'default)))
;; (face-attribute 'variable-pitch :family))) ; simple as this???
(let ((rv t))
(while (and facelist rv)
(let* ((face (car facelist))
(mapped (alist-get face face-remapping-alist)))
;; For the purposes of org-variable-pitch-mode, this suffices!
;; org-variable-pitch-face is badly named. It's
;; org-variable-pitch-mode's name for a face that is NOT
;; variable-pitch!
(cond ((memq 'org-variable-pitch-face mapped)
(setq rv nil)))
(setq facelist (cdr facelist))))
;; This still hides *and* smallifies marks in example blocks, which ought
;; to be left alone I would think. The face there is '(:inherit
;; org-block), which I don't have the machinery to interpret, and there
;; doesn't seem to be a property I can use to detect the block.
;; Is this really a reasonable way to tell?
(defun org-conceal-is-variable-pitch ()
;; I'm assuming default is not variable-pitch, ok?? This is surely
;; WRONG, yes?
;; Not good enough. Inside a table, for example, bold text has face
;; (bold org-table), and (face-at-point) gives just bold, which IS
;; variable-pitch. (face-at-point nil t) would give the whole list, but
;; how should I process it?
(boundp 'buffer-face-mode) buffer-face-mode
(facep 'org-variable-pitch-face)
;; Not looking into overlays; those are used for hiding, mostly.
(let ((faces (append (face-at-point nil t)
(list (get-text-property (point) 'face)))))
;; Not really good enough. Inside an example block, face-at-point says
;; nil, you have to look at the face text-property, which is (:inherit
;; (org-block)) (nested??) and THEN you need to realize that org-block
;; has a remap that mixes in org-variable-pitch-face.
(null faces)
(equal '(nil) faces) ; this happens because of the list fn above.
(is-face-variable-pitch faces)))))
(defun org-conceal-dont-conceal ()
;; Is this one of those situations wherein we don't conceal the markers?
(let ((props (text-properties-at (match-beginning 3))))
;; Exclude headers
(string-match-p "^\\**$" (match-string 2))
(plist-get props 'src-block))))
(defun org-conceal-pairs (limit orgre)
;; Just for debugging stuff.
;; (remove-overlays (point-min) (point-max) 'facecheck 'facecheck)
(while (re-search-forward orgre
limit t)
;; Exclude headers!
(if (and
;; Only do the ones where org-emphasis is set, right? Alas,
;; org-emphasis is set inside source blocks and things where we
;; probably shouldn't act.
(get-text-property (match-beginning 3) 'org-emphasis)
(not (org-conceal-dont-conceal)))
(let* (
(start1 (match-beginning 3))
(end1 (match-end 3))
(start2 (match-end 4))
(end2 (match-beginning 5))
(delim (match-string 3))
(vp (and (/= org-conceal-vp-scale 1.0)
(fac (text-properties-at start1))
(curfaces (save-excursion
(goto-char (match-beginning 4))
(face-at-point nil t)))
(bg (or (org-conceal-get-color)
(face-attribute 'default ;???
:background nil t)))
(markstr (progn
0 (length delim)
(list :foreground bg)
;; Ideally this should be part of org-do-emphasis-faces or
;; something. Instead, I'm adding a function to the font-lock
;; keyword list, which works as a hook, running after
;; org-do-emphasis-faces and inspecting properties like
;; org-emphasis etc. But org-emphasis isn't really reliable
;; (I would think it shouldn't be set inside source blocks or
;; example blocks, but it is); would have been better if I
;; could work inside org-do-emphasis-faces, which really knows
;; what's what.
;; Perhaps if org-default is variable-pitch, we should
;; reduce the height of the propertized string? No, because
;; we might not be in a default-like place at the moment,
;; and the last place we want to mess with spacing is
;; inside a table! Can I inspect what font-lock-mode has
;; done to this spot already? I think the hook is run
;; at the start, not the end.
(lambda (x)
((spot position)
,(if (= x 0) start2 start1))
(first (min position other))
(last (max position other))
(pt (point))
(abs (- pt position))
(abs (- pt other)))))
(not (or (<= dist org-conceal-distance)
(> pt first) (< pt last)))))
. ,markstr))))
(when vp
;; OR you can put height in the display prop! display prop is busy.
(add-face-text-property start1 end1
(list :height org-conceal-vp-scale))
(add-face-text-property start2 end2
(list :height org-conceal-vp-scale)))
(add-text-properties start1 end1 (apply disprop '(0)))
(add-text-properties start2 end2 (apply disprop '(1)))))))
(define-minor-mode org-conceal-emphasis-mode
"Conceal emphasis markers (*/_+=) when point is within 7 of either end of
the emphasized string, or is within the emphasized string."
;; (if org-conceal-emphasis-mode
;; (add-hook 'org-font-lock-hook #'org-conceal-emph-pairs)
;; (remove-hook 'org-font-lock-hook #'org-conceal-emph-pairs))
(if org-conceal-emphasis-mode
(add-to-list 'font-lock-extra-managed-props 'display)
(font-lock-add-keywords nil '((org-conceal-emph-pairs)) t))
(font-lock-remove-keywords nil '((org-conceal-emph-pairs))))
;; BUGS:
;; - hides "+" signs in tables that indicate table rules crossing.
;; - NOPE! Not anymore! Not since check for org-emphasis prop!
;; - looks like things can get confused as to what's the extent of an
;; emphasized string, crossing block boundaries and stuff.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment