Hello,
Shankar Rao <shankar....@gmail.com> writes:
> I agree with you that my solution is somewhat intrusive. Ideally, I would
> have preferred that my solution could leverage advice functions or some Org
> hook, so that I wouldn't have to modify org.el, but it doesn't seem like
> there is a straightforward way to do that. The modification of
> `post-command-hook', similar to one used for `prettify-symbols-mode', only
> occurs if `org-auto-emphasis-mode' is active
The problem is not your implementation, really. It's just that I don't
think it should be the _built-in_ way to solve emphasis management. IOW,
we shouldn't need to activate a minor mode to make that management
tolerable in the first place.
However, I agree that it makes senses as an extension, in the same vein
as `org-fragtog` for LaTeX fragments.
> So in your system, in order to interact with emphasis markers, the user
> would have to learn two different commands? That doesn't seem to be in line
> with the dwim philosophy used in modern emacs packages.
Two different commands? Bah! The change I suggest introduces 7 new
commands and 12 new bindings! :)
Yet, I claim it is still (somewhat) intuitive.
> In my opinion, one of the strengths of Org is that the interface is
> multimodal. One can (in principle) edit documents in much the same way as
> word processors and rich text editors. However since everything underneath
> is implemented with just text, one can also directly access and manipulate
> this text. The ability to switch between these two modalities is extremely
> powerful and is what sets Org apart from other document editing
> systems.
You can always toggle `visible-mode' for that.
But, really, I think an option like `org-hide-emphasis-markers' is
a one-off toggle. Having to, in a way, switch regularly between two
values is sub-optimal.
> I look forward to seeing your proposed system more concretely.
Here it is.
The main command is `org-emphasis'. It emphasizes the minimal possible
area around point, or region. If there's already an emphasis object of
the desired type around point or region, it extends it forward instead.
With a prefix argument, it removes the emphasis.
Interactively, the command asks for the type of emphasis to use, but
I suggest to use dedicated commands instead. Thus, I added a key-binding
for each of the six emphasis types. For example, for bold, use
`M-o *' or `M-o M-*'
There are equivalent commands for underline (`M-o _` or `M-o M-_'), and
so on.
Note there, even though I polished it, there are probably some glitches
left, but it works well enough to give an idea. Tests are missing, too.
Please evaluate the following code to try it.
--8<---------------cut here---------------start------------->8---
(defun org--emphasis-flatten-region (begin end parent)
"Find minimal region around BEGIN and END with boundaries at the same level.
PARENT is the parent element containing both BEGIN and END.
Return a list
(B E CONTEXT)
where B and E are, respectively, the start and the end of the smallest region
containing BEGIN and END, but with a guaranteed common parent object or element
CONTEXT."
(let ((context-beg (org-with-point-at begin (org-element-context parent))))
;; Find common container.
(when (/= begin end)
(let ((context-end (org-with-point-at end (org-element-context parent))))
(while (>= end (org-element-property :end context-beg))
(setq begin (org-element-property :begin context-beg))
(setq context-beg (org-element-property :parent context-beg)))
(while (< begin (org-element-property :begin context-end))
(goto-char (org-element-property :end context-end))
(skip-chars-backward " \n\t")
(setq end (point))
(setq context-end (org-element-property :parent context-end)))))
;; Make sure that we do not end up with one boundary inside the
;; common context, and the other boundary outside of it. Also move
;; out of objects that cannot contain emphasis (e.g., bold).
(when (or (not (memq 'bold (org-element-restriction context-beg)))
(< begin (org-element-property :contents-begin context-beg))
(> end (org-element-property :contents-end context-beg)))
(setq begin (org-element-property :begin context-beg))
(goto-char (org-element-property :end context-beg))
(skip-chars-backward " \n\t")
(setq end (point)))
;; Return value.
(list begin end context-beg)))
(defun org--emphasis-extend-region (begin end parent type)
"Return smallest area extending emphasis between BEGIN and END.
PARENT is an element, as returned by `org-element-at-point'. The
function assumes PARENT contents include both BEGIN and END
positions.
TYPE is emphasis type being extended, as a symbol `bold', `code',
`italic', `strike-through', `underline', and `verbatim'.
Return nil if there is no possible location for the emphasis
markup. Otherwise, return (A . B) where A and B are buffer
positions where emphasis markers can be inserted."
(org-with-wide-buffer
;; Skip any white space so that the command marks the following
;; word, à la `mark-word'.
(let ((limit (org-element-property :contents-end parent)))
(goto-char begin)
(skip-chars-forward " \t\n" limit)
(setq begin (and (> limit (point)) (point))))
;; At the end of the element, there is nothing to emphasize, so
;; bail out.
(when begin
(goto-char end)
(skip-chars-backward " \t\n" begin)
(setq end (max begin (point)))
(pcase (org--emphasis-flatten-region begin end parent)
(`(,new-begin ,new-end ,context)
;; Special case: when there's an emphasis object of the
;; desired type around the area we're interested in, drop the
;; area and extend the object instead.
(let ((emphasis (org-element-lineage context (list type) t)))
(when emphasis
(setq context (org-element-property :parent emphasis))
(setq new-begin (org-element-property :begin emphasis))
;; Force extending after the object only, if possible.
(setq new-end
(and (< (org-element-property :end emphasis)
(org-with-point-at
(org-element-property :contents-end context)
(skip-chars-backward " \t\n")
(point)))
(1+ (org-element-property :end emphasis))))
(setq begin 0)
(setq end new-end)))
(when (= begin new-begin)
;; Find an acceptable BEGIN position for the opening
;; emphasis marker. It must be located after an appropriate
;; prefix, but not before a white space. We repeatedly try
;; to find such a location.
(let* ((limit (org-element-property :contents-begin context))
(prefix-re "-\"'({[:space:]")
(non-prefix-re (concat "^" prefix-re)))
(goto-char new-begin)
(skip-chars-backward non-prefix-re limit)
(while (eq ?\s (char-syntax (char-after))) ;invalid border
(skip-chars-backward prefix-re limit)
(skip-chars-backward non-prefix-re limit)))
(setq new-begin (point)))
(when (and new-end (= end new-end))
;; Find an acceptable END position for the closing emphasis
;; marker. It must be located between a non-space character
;; and an appropriate suffix. We look for the next position
;; before the suffix, and check if there is no space behind.
;; Rinse and repeat.
(let* ((limit (org-element-property :contents-end context))
(suffix-re "-[:space:]!\"',.:;?)}\\[")
(non-suffix-re (concat "^" suffix-re)))
(goto-char new-end)
(skip-chars-forward non-suffix-re limit)
(while (eq ?\s (char-syntax (char-before))) ;invalid border
(skip-chars-forward suffix-re limit)
(skip-chars-forward non-suffix-re limit)))
(setq new-end (point)))
;; Return value.
(and new-begin new-end (cons new-begin new-end)))
(other
(error "Invalid return value for `org--emphasis-flatten-region': %S"
other))))))
(defun org--emphasis-clean-markup (type beg end)
"Remove all emphasis of type TYPE between BEG and END.
TYPE is a symbol among `bold', `code', `italic', `strike-through',
`underline', and `verbatim'.
The function assumes BEG and END both belong to the same element."
(save-restriction
(narrow-to-region beg end)
(save-excursion
;; Remove markup in reverse order so object boundaries are still
;; accurate after each buffer modification.
(dolist (o (reverse (org-element-map (org-element-parse-buffer) type
#'identity)))
(goto-char (org-element-property :end o))
(skip-chars-backward " \t")
(delete-char -1)
(goto-char (org-element-property :begin o))
(delete-char 1)))))
(defun org--emphasis-container (begin end)
"Return element around BEGIN and END possibly containing emphasis.
Return nil if there is no such element."
(org-with-point-at begin
(let ((element (org-element-at-point)))
(pcase (org-element-type element)
;; XXX: Item's tag and headline title can contain emphasis.
;; However, other places in these elements cannot. If BEGIN
;; and END are located appropriately, return a fake element
;; limiting contents to the tag or the title.
((or `headline `inlinetask `item)
(when (and (or (org-match-line org-complex-heading-regexp)
(org-match-line org-list-full-item-re))
(org-string-nw-p (match-string 4))
(org-pos-in-match-range begin 4)
(org-pos-in-match-range end 4))
(let ((new (org-element-copy element)))
(org-element-put-property new :contents-begin (match-beginning 4))
(goto-char (match-end 4))
(skip-chars-backward " \t")
(org-element-put-property new :contents-end (point))
new)))
(type
(and (memq type org-element-object-containers)
(>= begin (org-element-property :contents-begin element))
(<= end (org-element-property :contents-end element))
element))))))
(defun org-emphasis (&optional arg type)
"Apply or remove emphasis at point, or in region.
Emphasize minimal area around region or point. If the area is already
emphasized, extend it forward. In that case, point is left within the
emphasis.
When called with an universal prefix argument, remove emphasis
around and within region instead.
When called interactively, ask for the type of emphasis to apply or remove.
When optional argument TYPE is provided, use that emphasis type instead."
(interactive "P")
;; Make sure to consider the next non-white character (or end of
;; line, since we don't want to move out of the current element).
(let* ((region? (org-region-active-p))
(region-start (and region? (region-beginning)))
(region-end (and region? (region-end)))
(begin
(progn
(goto-char (or region-start (point)))
(skip-chars-forward " \t")
(point)))
(end (max begin (or region-end (point))))
(parent (org--emphasis-container begin end)))
(unless parent (user-error "Cannot emphasize contents here"))
;; Now proceed according to ARG.
(let* ((type
(pcase (or type (read-char "Choose emphasis [*~/+_=]: "))
((or ?* `bold) 'bold)
((or ?~ `code) 'code)
((or ?/ `italic) 'italic)
((or ?+ `strike-through) 'strike-through)
((or ?_ `underline) 'underline)
((or ?= `verbatim) 'verbatim)
(answer (user-error "Unknown markup type: %S" answer))))
(markup
(pcase type
(`bold ?*) (`code ?~) (`italic ?/) (`strike-through ?+)
(`underline ?_) (_ ?=))))
(pcase arg
;; No argument: insert emphasis markers.
(`nil
(pcase (org--emphasis-extend-region begin end parent type)
(`nil
(user-error
(if (org-element-lineage (org-element-context parent) (list type)
t)
"Cannot extend emphasis further"
"Nothing to emphasize in the region")))
(`(,begin . ,end)
(if (and (or (< begin (point-min)) (> end (point-max)))
(not (yes-or-no-p "Insert markers outside visible part \
of buffer? ")))
(message "Emphasis markup insertion aborted")
;; First delete all markup, then insert new one. The
;; first action modifies buffer, so we store insertion
;; location in markers.
;;
;; Also, pay attention to the final position, which
;; should always end within new markers.
(let ((begin-marker (copy-marker begin))
(end-marker (copy-marker end))
(origin (point-marker)))
(org--emphasis-clean-markup type begin end)
(org-with-point-at origin
(goto-char end-marker)
(insert markup)
(goto-char begin-marker)
(insert-before-markers markup))
(set-marker begin-marker nil)
(set-marker end-marker nil)
(set-marker origin nil))))
(value (error "Invalid return value %S" value))))
;; Non-nil argument: remove emphasis markers.
(_
(pcase (org--emphasis-flatten-region begin end parent)
(`(,begin ,end ,context)
(let ((emphasis (org-element-lineage context (list type) t)))
(if (not emphasis)
(org--emphasis-clean-markup type begin end)
;; We're already within emphasis object of the desired
;; type: delete it.
(org-with-point-at (org-element-property :end emphasis)
(skip-chars-backward " \t")
(delete-char -1))
(org-with-point-at (org-element-property :begin emphasis)
(delete-char 1)))))
(other
(error "Unknown return value for `org--emphasis-flatten-region': %S"
other))))))))
(defun org-emphasis-bold (&optional arg)
"Emphasize area around point or region with bold markup.
When optional argument ARG is non-nil, remove such markup
instead."
(interactive "P")
(org-emphasis arg 'bold))
(defun org-emphasis-code (&optional arg)
"Emphasize area around point or region with code markup.
When optional argument ARG is non-nil, remove such markup
instead."
(interactive "P")
(org-emphasis arg 'code))
(defun org-emphasis-italic (&optional arg)
"Emphasize area around point or region with italic markup.
When optional argument ARG is non-nil, remove such markup
instead."
(interactive "P")
(org-emphasis arg 'italic))
(defun org-emphasis-strike-through (&optional arg)
"Emphasize area around point or region with strike-through markup.
When optional argument ARG is non-nil, remove such markup
instead."
(interactive "P")
(org-emphasis arg 'strike-through))
(defun org-emphasis-underline (&optional arg)
"Emphasize area around point or region with underline markup.
When optional argument ARG is non-nil, remove such markup
instead."
(interactive "P")
(org-emphasis arg 'underline))
(defun org-emphasis-verbatim (&optional arg)
"Emphasize area around point or region with verbatim markup.
When optional argument ARG is non-nil, remove such markup
instead."
(interactive "P")
(org-emphasis arg 'verbatim))
;;; Suggested bindings
(org-defkey org-mode-map (kbd "M-o *") 'org-emphasis-bold)
(org-defkey org-mode-map (kbd "M-o M-*") 'org-emphasis-bold)
(org-defkey org-mode-map (kbd "M-o ~") 'org-emphasis-code)
(org-defkey org-mode-map (kbd "M-o M-~") 'org-emphasis-code)
(org-defkey org-mode-map (kbd "M-o /") 'org-emphasis-italic)
(org-defkey org-mode-map (kbd "M-o M-/") 'org-emphasis-italic)
(org-defkey org-mode-map (kbd "M-o +") 'org-emphasis-strike-through)
(org-defkey org-mode-map (kbd "M-o M-+") 'org-emphasis-strike-through)
(org-defkey org-mode-map (kbd "M-o _") 'org-emphasis-underline)
(org-defkey org-mode-map (kbd "M-o M-_") 'org-emphasis-underline)
(org-defkey org-mode-map (kbd "M-o =") 'org-emphasis-verbatim)
(org-defkey org-mode-map (kbd "M-o M-=") 'org-emphasis-verbatim)
--8<---------------cut here---------------end--------------->8---
Regards,
--
Nicolas Goaziou
