nftable-migration
1;;; org-extra-emphasis.el --- Extra Emphasis markers for Org -*- lexical-binding: t; coding: utf-8-emacs; -*-
2
3;; Copyright (C) 2022 Jambunathan K <kjambunathan at gmail dot com>
4;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
5
6;; Author: Jambunathan K <kjambunathan at gmail dot com>
7;; Keywords: org
8;; Homepage: https://github.com/kjambunathan/org-extra-emphasis
9;; Version: 1.0
10;; Package-Requires: ((ox-odt "9.5.3.467"))
11
12;; This file is NOT part of GNU Emacs.
13
14;; This program is free software: you can redistribute it and/or
15;; modify it under the terms of the GNU General Public License as
16;; published by the Free Software Foundation, either version 3 of the
17;; License, or (at your option) any later version.
18
19;; This program is distributed in the hope that it will be useful, but
20;; WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22;; General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27;;; Commentary:
28
29;; Overview
30;; ========
31;;
32;; This library provides two additional markers `!!' and `!@' over
33;; and above those in `org-emphasis-alist'.'
34;;
35;; - Text enclosed in `!!' is highlighted in yellow, and exported likewise
36;; - Text enclosed in `!@' is displayed in red, and exported likewise
37;;
38;; Following backends are supported: HTML and ODT. For export of extra
39;; emphasis markers to the ODT side, you need
40;; [[https://github.com/kjambunathan/org-mode-ox-odt][Enhanced ODT]]
41;; exporter with version >= 9.5.3.467 (dtd. June 14, 2022 IST). This
42;; is the first version of the exporter that defines the user option
43;; `org-odt-extra-styles'.
44;;
45;; Example
46;; =======
47;;
48;; Setup
49;; =====
50;;
51;; Add the following to your `user-init-file' and restart Emacs.
52;;
53;; (requrie 'org-extra-emphasis)
54;;
55;; Test Run
56;; ========
57;;
58;; 1. Create an `org' file, say `org-export-emphasis.org' and fill it
59;; with following content or you can download the file from
60;; https://raw.githubusercontent.com/kjambunathan/org-extra-emphasis/main/org-extra-emphasis.org
61
62 ;; #+TITLE: Test file for ==org-extra-emphasis== library
63
64 ;; * Demo of extra emphasis markers ==!!== and ==!@==
65
66 ;; !!Ea consectetur laboris adipiscing et ipsum labore esse qui minim
67 ;; pariatur et sunt sunt nostrud anim laborum culpa.!!
68
69 ;; !@Minim reprehenderit excepteur elit, dolore elit, veniam, eu.
70 ;; Ullamco dolore elit, cupidatat sed labore ea aute.!@
71
72 ;; Pariatur !!et lorem cupidatat !@minim irure!@ proident, ad.!! Eiusmod
73 ;; sunt et lorem labore ex aliqua aute esse.
74
75 ;; Ut mollit !@duis velit est est magna in quis ipsum. !!Aliqua aliqua
76 ;; non laboris exercitation cupidatat aliqua incididunt.!! Qui voluptate
77 ;; irure aute occaecat laborum cillum est.!@ Quis magna dolor ullamco
78 ;; magna do consectetur est laborum enim ut.
79
80 ;; * !!Demo of extra emphasis markers in a styled paragraph!!
81
82 ;; #+ATTR_ODT: :target "extra_styles"
83 ;; #+begin_src nxml
84 ;; <style:style style:name="Warn"
85 ;; style:parent-style-name="Text_20_body"
86 ;; style:family="paragraph">
87 ;; <style:paragraph-properties>
88 ;; <style:tab-stops />
89 ;; </style:paragraph-properties>
90 ;; <style:text-properties fo:background-color="#ff0000"
91 ;; fo:color="#ffffff"
92 ;; fo:font-size="20pt"
93 ;; fo:font-style="italic"
94 ;; fo:font-weight="bold" />
95 ;; </style:style>
96 ;; #+end_src
97
98 ;; #+ATTR_ODT: :style "Warn"
99 ;; Proident, duis dolore consectetur sed nisi ea pariatur. Esse
100 ;; proident, cillum duis qui ullamco sint cillum magna. !!Eiusmod
101 ;; veniam, !@sint officia!@ non consectetur laboris cillum.!! Cillum
102 ;; mollit consequat eu dolore ullamco qui reprehenderit anim cillum
103 ;; in consectetur consequat sunt dolore aliquip voluptate
104 ;; consectetur anim ea. Voluptate nisi est incididunt aliquip
105 ;; excepteur aliqua id do enim ut non consequat.
106;;
107;; 2. Note that portions of text marked with `!!' and `!@' are fontified as described above.
108;;
109;; 3. Export the file to HTML with `C-c C-e h O'.
110;;
111;; Note that the text enclosed in the above emphasis markers are
112;; colorized in HTML file.
113;;
114;; 4. Export the file to ODT with `C-c C-e o O'.
115;;
116;; Note that the text enclosed in the above emphasis markers are
117;; colorized in ODT file.
118;;
119;; The HTML, ODT, PDF generated in steps (3) and (4) above are
120;; available at https://github.com/kjambunathan/org-extra-emphasis and
121;; the screenshots can be seen in https://github.com/kjambunathan/org-extra-emphasis/tree/main/screenshots
122;;
123
124;; Default Settings
125;; ================
126;;
127;; 16 Emphasis Markers
128;; ===================
129;;
130;; This library defines the following 16 emphasis markers,
131;;
132;; |----+----+----+----|
133;; | !! | !@ | !% | !& |
134;; |----+----+----+----|
135;; | @! | @@ | @% | @& |
136;; |----+----+----+----|
137;; | %! | %@ | %% | %& |
138;; |----+----+----+----|
139;; | &! | &@ | &% | && |
140;; |----+----+----+----|
141;;
142;; The above markers are all pairings of the following four characters:
143;; ! @ % &
144;;
145;; It is hoped that these set of emphasis markers don't pose issues
146;; while exporting.
147;;
148;; 17 Extra Emphasis Faces
149;; =======================
150;;
151;; This library defines 17 faces:
152;;
153;; - one base face `org-extra-emphasis'
154;; - 16 more faces `org-extra-emphasis-01',`org-extra-emphasis-02',
155;; ..., `org-extra-emphasis-16'.
156;;
157;; The later 16 faces derive from `org-extra-emphasis' face. Of
158;; these, only the first two faces `org-extra-emphasis-01' and
159;; `org-extra-emphasis-02' are explicitly configured. If you are
160;; using more than 2 emphasis markers, you may want to configure the
161;; other 14 faces.
162;;
163;; `org-extra-emphasis-alist' already associated 16 emphasis markers
164;; with 16 different faces.
165;;
166;; Customization
167;; =============
168;;
169;; Configuring your own Emphasis Markers
170;; =====================================
171;;
172;; 16 numbers of emphasis markers should suffice in practice.
173;; However, if none of the above emphasis markers resonate with you,
174;; you can customize `org-extra-emphasis-alist', and plug in your own
175;; markers. When choosing your own marker, ensure that you exercise
176;; some care. For example, if you choose `#' as a marker you are
177;; likely to get malformed `html' and `odt' files.
178;;
179;; Configuring Extra Emphasis Faces
180;; ===============================
181;;
182;; You can use `M-x customize-group RET org-extra-emphasis-faces RET'
183;; to configure the extra emphasis faces.
184;;
185;; Disabling the Extra Emphasis
186;; =============================
187;;
188;; You can use `M-x org-extra-emphasis-mode' to toggle this feature.
189;;
190;; Adding additional export backends
191;; =================================
192;;
193;; To add additional backends, modify `org-extra-emphasis-formatter'
194;; and `org-extra-emphasis-build-backend-regexp'.
195
196;;; Code:
197
198(require 'org)
199(require 'ox-odt)
200(require 'rx)
201(require 'htmlfontify)
202
203;;; PART-1: `org-extra-emphasis-mode'
204
205;;;; Internal Variables
206
207(defvar org-extra-emphasis-backends
208 '(html odt ods))
209
210(defvar org-extra-emphasis-info
211 (list :enabled nil))
212
213;; Helper snippets to convert a Emacs Face to Inine CSS and ODT Text Properties
214;;
215;; (defun org-extra-emphasis-emacs-face->inline-css (face)
216;; (let ((s (cdr (hfy-face-to-css-default face))))
217;; (when (string-match (rx-to-string '(and "{" (group (zero-or-more any)) "}")) s)
218;; (format "<span style=\"%s\">%%s</span>" (match-string 1 s)))))
219;;
220;; (org-extra-emphasis-emacs-face->inline-css 'hi-yellow)
221;; (org-extra-emphasis-emacs-face->inline-css 'hi-red-b)
222;;
223;; (defun org-extra-emphasis-emacs-face->odt-text-properties (face)
224;; (org-odt--lisp-to-xml
225;; (assoc 'style:text-properties
226;; (org-odt--xml-to-lisp
227;; (cdr (org-odt-hfy-face-to-css face))))))
228;;
229;; (org-extra-emphasis-emacs-face->odt-text-properties 'hi-yellow)
230;; (org-extra-emphasis-emacs-face->odt-text-properties 'hi-red-b)
231
232(defun org-extra-emphasis-update (&rest _ignored)
233 "Workhorse function that responds to configuration changes.
234
235Current state is maintined in `org-extra-emphasis-info', a plist."
236 ;; When `org-extra-emaphasis' is ON, override use
237 ;; `org-extra-emphasis-org-do-emphasis-faces'.
238 ;; Otherwise, use `org-do-emphasis-faces'.
239 (cond
240 ((plist-get org-extra-emphasis-info :enabled)
241 (advice-add 'org-do-emphasis-faces :override
242 'org-extra-emphasis-org-do-emphasis-faces))
243 (t
244 (advice-remove 'org-do-emphasis-faces
245 'org-extra-emphasis-org-do-emphasis-faces)))
246 ;; `org-extra-emphasis-alist' is effective only if
247 ;; `org-extra-emphasis' is enabled.
248 (plist-put org-extra-emphasis-info :work-alist
249 (when (plist-get org-extra-emphasis-info :enabled)
250 (plist-get org-extra-emphasis-info :alist)))
251 ;; Set properties that control fontification.
252 ;; The property names and their values mimics the corresponding
253 ;; variables in `org-set-emph-re'.
254 (plist-put org-extra-emphasis-info :org-emphasis-alist
255 (when (and (boundp 'org-emphasis-regexp-components)
256 org-emphasis-alist org-emphasis-regexp-components)
257 (append (plist-get org-extra-emphasis-info :work-alist)
258 org-emphasis-alist)))
259 (plist-put org-extra-emphasis-info :org-emph-re-template
260 (when (and (boundp 'org-emphasis-regexp-components)
261 org-emphasis-alist org-emphasis-regexp-components)
262 (pcase-let*
263 ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
264 (body (if (<= nl 0) body
265 (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl))))
266 (format (concat "\\([%s]\\|^\\)" ;before markers
267 "\\(\\(%%s\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
268 "\\([%s]\\|$\\)") ;after markers
269 pre border border body border post))))
270 (plist-put org-extra-emphasis-info :org-emph-re
271 (format (plist-get org-extra-emphasis-info :org-emph-re-template)
272 (rx-to-string
273 `(or ,@(mapcar #'car
274 (cl-remove-if (lambda (l)
275 (eq 'verbatim (nth 2 l)))
276 (plist-get org-extra-emphasis-info :org-emphasis-alist)))))))
277 (plist-put org-extra-emphasis-info :org-verbatim-re
278 (format (plist-get org-extra-emphasis-info :org-emph-re-template)
279 (rx-to-string
280 `(or ,@(mapcar #'car
281 (cl-remove-if-not (lambda (l)
282 (eq 'verbatim (nth 2 l)))
283 (plist-get org-extra-emphasis-info :org-emphasis-alist)))))
284 (rx-to-string
285 `(or ,@(mapcar #'car
286 (cl-remove-if-not (lambda (l)
287 (eq 'verbatim (nth 2 l)))
288 (plist-get org-extra-emphasis-info :org-emphasis-alist)))))))
289 ;; Set properties that control Export backends
290 ;; - Regexp to search for in the final exported document
291 (plist-put org-extra-emphasis-info :export-alist
292 (org-extra-emphasis-build-backend-regexp))
293
294 ;; - Generate ODT character styles for the extra emphasis faces and
295 ;; dump those in `org-odt-extra-styles' and `org-ods-automatic-styles'.
296 (plist-put org-extra-emphasis-info :odt-extra-styles
297 (let* ((odt-styles
298 (concat (mapconcat #'identity
299 (cl-loop for (_marker face) in (plist-get org-extra-emphasis-info :alist)
300 collect (cdr (org-odt-hfy-face-to-css face)))
301 "\n\n"))))
302 (with-no-warnings
303 (unless (boundp 'org-odt-extra-styles)
304 (message "`org-odt-extra-styles' not found. Upgrade to `ox-odt-9.5.3.467' or later.")
305 ;; (sleep-for 2)
306 (setq org-odt-extra-styles nil))
307 (setq org-odt-extra-styles
308 (concat (or (when (boundp 'org-odt-extra-styles)
309 (get 'org-odt-extra-styles 'saved-value))
310 "")
311 "\n\n"
312 odt-styles))
313 (setq org-ods-automatic-styles
314 (concat (or (when (boundp 'org-ods-automatic-styles)
315 (get 'org-ods-automatic-styles 'saved-value))
316 "")
317 "\n\n"
318 odt-styles))
319 (message "`org-odt-extra-styles' and `org-ods-automatic-styles' is updated for this session")
320 ;; (sleep-for 1)
321 )
322 odt-styles))
323 ;; Re-fontify all Org buffers based on current configuration.
324 (dolist (buffer (buffer-list))
325 (with-current-buffer buffer
326 (when (derived-mode-p 'org-mode)
327 (font-lock-flush)))))
328
329;;;; Fontify Extra Emphasis Markers
330
331(defun org-extra-emphasis-org-do-emphasis-faces (limit)
332 "Workhorse function that does fontification This function is
333based on `org-do-emphasis-faces'. The property names and values
334correspond to the variables used in `org-do-emphasis-faces'. Key
335differences are:
336
337 - `:org-emphasis-alist' includes entries for both standard
338 emphasis markers and extra emphasis markers.
339
340 - The regexes used for search-based fontification allow for
341 the possibility that the emphasis markers _in all
342 likelihood_ are multi-char strings, as opposed to single
343 chars."
344 (let* ((quick-re (format "\\([%s]\\|^\\)\\(%s\\)"
345 (car org-emphasis-regexp-components)
346 (rx-to-string
347 `(or ,@(mapcar #'car (plist-get org-extra-emphasis-info :org-emphasis-alist)))))))
348 (catch :exit
349 (while (re-search-forward quick-re limit t)
350 (let* ((marker (match-string 2))
351 (verbatim? (member marker '("~" "="))))
352 (when (save-excursion
353 (goto-char (match-beginning 0))
354 (and
355 ;; Do not match table hlines.
356 (not (and (equal marker "+")
357 (org-match-line
358 "[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$")))
359 ;; Do not match headline stars. Do not consider
360 ;; stars of a headline as closing marker for bold
361 ;; markup either.
362 (not (and (equal marker "*")
363 (save-excursion
364 (forward-char)
365 (skip-chars-backward "*")
366 (looking-at-p org-outline-regexp-bol))))
367 ;; Match full emphasis markup regexp.
368 (looking-at (if verbatim? (plist-get org-extra-emphasis-info :org-verbatim-re)
369 (plist-get org-extra-emphasis-info :org-emph-re)))
370 ;; Do not span over paragraph boundaries.
371 (not (string-match-p org-element-paragraph-separate
372 (match-string 2)))
373 ;; Do not span over cells in table rows.
374 (not (and (save-match-data (org-match-line "[ \t]*|"))
375 (string-match-p "|" (match-string 4))))))
376 (pcase-let ((`(,_ ,face ,_) (assoc marker (plist-get org-extra-emphasis-info :org-emphasis-alist)))
377 (m (if org-hide-emphasis-markers 4 2)))
378 (font-lock-prepend-text-property
379 (match-beginning m) (match-end m) 'face face)
380 (when verbatim?
381 (org-remove-flyspell-overlays-in
382 (match-beginning 0) (match-end 0))
383 (remove-text-properties (match-beginning 2) (match-end 2)
384 '(display t invisible t intangible t)))
385 (add-text-properties (match-beginning 2) (match-end 2)
386 '(font-lock-multiline t org-emphasis t))
387 (when (and org-hide-emphasis-markers
388 (not (org-at-comment-p)))
389 (add-text-properties (match-end 4) (match-beginning 5)
390 '(invisible t))
391 (add-text-properties (match-beginning 3) (match-end 3)
392 '(invisible t)))
393 (throw :exit t))))))))
394
395;; There is no `:set' function for `deffaces'. So, when the extra
396;; faces `org-extra-emphasis-01', `org-extra-emphasis-02' reconfigured,
397;; we don't get a notification. The following export hook ensures
398;; that `org-extra-emphasis-info' is in sync with user configuration.
399(add-hook 'org-export-before-processing-hook 'org-extra-emphasis-update)
400
401;;;; Export Extra Emphasis Markers
402
403(defun org-extra-emphasis-formatter (marker text backend)
404 "Style TEXT in the same font face as the face MARKER is mapped to.
405Note that TEXT is in BACKEND format.
406
407This currently supports HTML and ODT backends.
408
409See `org-extra-emphasis-alist' for MARKER to face mappings."
410 (let* ((face (car (assoc-default marker (plist-get org-extra-emphasis-info :work-alist))))
411 (encode-attribute-value
412 (lambda (text)
413 (dolist (pair '(("&" . "&")
414 ("<" . "<")
415 (">" . ">")
416 ("'" . "'")
417 ("\"" . """)))
418 (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
419 text)))
420 (cl-case backend
421 ((odt ods)
422 (format "<text:span text:style-name=\"%s\">%s</text:span>"
423 (car (org-odt-hfy-face-to-css face)) text))
424 (html
425 (format "<span class=\"%s\" style=\"%s\">%s</span>"
426 face
427 ;; An alternate implementation of
428 ;; `hfy-face-to-css-default' which performs correctly
429 ;; when a face specifies a `:family', and/or inherits
430 ;; some attributes from other faces. Note that the
431 ;; flattening (or non-duplication) of face attributes
432 ;; here is done by Emacs itself.
433 (mapconcat (lambda (x)
434 (when (cdr x)
435 (format "%s: %s;" (car x)
436 (funcall encode-attribute-value (cdr x)))))
437 (hfy-face-to-style-i
438 (cl-loop with props = (mapcar #'car face-attribute-name-alist)
439 for prop in props
440 for value = (face-attribute face prop nil 'default)
441 unless (eq prop :inherit)
442 append (list prop value)))
443 " ")
444 text))
445 (_ text))))
446
447(defun org-extra-emphasis-build-backend-regexp ()
448 "Regexp to search for emphasized text in exported file.
449This function transcode an emphasis MARKER which is in plain text
450format, to the BACKEND format. That is, if you use `<<' as an
451emphasis marker, you need to search for `<<' in the
452exported HTML file.
453
454See `org-extra-emphasis-alist' for more information"
455 (cl-loop for (marker . spec) in (plist-get org-extra-emphasis-info :work-alist) collect
456 (cons marker
457 (cl-loop for backend in org-extra-emphasis-backends collect
458 (cons backend
459 (rx-to-string `(and ,(org-export-data-with-backend marker backend nil)
460 (group (minimal-match
461 (zero-or-more (or any "\n"))))
462 ,(org-export-data-with-backend marker backend nil))))))))
463
464(defun org-extra-emphasis-plain-text-filter (text backend _info)
465 "Transcode TEXT in to BACKEND format.
466Uses `org-extra-emphasis-formatter' to do the transcoding.
467
468Search TEXT for one or more transcoded MARKERs, and mark it up as
469specified in `org-extra-emphasis-alist'."
470 (with-temp-buffer
471 (insert text)
472 (cl-loop for (marker . spec) in (plist-get org-extra-emphasis-info :export-alist)
473 for regex = (assoc-default backend spec)
474 do (goto-char (point-min))
475 (if (not regex) text
476 (while (re-search-forward regex nil t)
477 (let* ((contents (match-string 1))
478 (emphasized-contents (save-match-data
479 (org-extra-emphasis-formatter
480 marker contents backend))))
481 (replace-match emphasized-contents t t)))))
482 (buffer-substring-no-properties (point-min) (point-max))))
483
484;; Install export filter for transcoding extra emphasis markers.
485(defun org-extra-emphasis-update-filter-functions (&optional export-filter-functions)
486 (let* ((all-filter-functions (thread-last org-export-filters-alist
487 (seq-map #'cdr)
488 (seq-sort #'string<))))
489 (dolist (filter-fn '(org-extra-emphasis-plain-text-filter org-extra-emphasis-strip-zws-maybe))
490 (dolist (it all-filter-functions)
491 (set it (delq filter-fn (symbol-value it))))
492 (dolist (it export-filter-functions)
493 (add-to-list it filter-fn)))))
494
495;;;; User Options & Commands
496
497;;;;; Custom Groups
498
499(defgroup org-extra-emphasis nil
500 "Options for highlighting and exporting extra emphasis markers in Org files."
501 :tag "Org Extra Emphasis"
502 :group 'org)
503
504(defgroup org-extra-emphasis-faces nil
505 "Faces for Org Extra Emphasis."
506 :group 'org-extra-emphasis
507 :group 'faces)
508
509;;;; Custom Faces
510
511(defface org-extra-emphasis nil
512 "A face for Org Extra Emphasis."
513 :group 'org-extra-emphasis-faces)
514
515(defface org-extra-emphasis-01
516 '((t (:inherit org-extra-emphasis :background "yellow")))
517 "A face for Org Extra Emphasis."
518 :group 'org-extra-emphasis-faces)
519
520(defface org-extra-emphasis-02
521 '((t (:inherit org-extra-emphasis :foreground "red")))
522 "A face for Org Extra Emphasis."
523 :group 'org-extra-emphasis-faces)
524
525(defface org-extra-emphasis-03
526 '((t (:inherit org-extra-emphasis)))
527 "A face for Org Extra Emphasis."
528 :group 'org-extra-emphasis-faces)
529
530(defface org-extra-emphasis-04
531 '((t (:inherit org-extra-emphasis)))
532 "A face for Org Extra Emphasis."
533 :group 'org-extra-emphasis-faces)
534
535(defface org-extra-emphasis-05
536 '((t (:inherit org-extra-emphasis)))
537 "A face for Org Extra Emphasis."
538 :group 'org-extra-emphasis-faces)
539
540(defface org-extra-emphasis-06
541 '((t (:inherit org-extra-emphasis)))
542 "A face for Org Extra Emphasis."
543 :group 'org-extra-emphasis-faces)
544
545(defface org-extra-emphasis-07
546 '((t (:inherit org-extra-emphasis)))
547 "A face for Org Extra Emphasis."
548 :group 'org-extra-emphasis-faces)
549
550(defface org-extra-emphasis-08
551 '((t (:inherit org-extra-emphasis)))
552 "A face for Org Extra Emphasis."
553 :group 'org-extra-emphasis-faces)
554
555(defface org-extra-emphasis-09
556 '((t (:inherit org-extra-emphasis)))
557 "A face for Org Extra Emphasis."
558 :group 'org-extra-emphasis-faces)
559
560(defface org-extra-emphasis-10
561 '((t (:inherit org-extra-emphasis)))
562 "A face for Org Extra Emphasis."
563 :group 'org-extra-emphasis-faces)
564
565(defface org-extra-emphasis-11
566 '((t (:inherit org-extra-emphasis)))
567 "A face for Org Extra Emphasis."
568 :group 'org-extra-emphasis-faces)
569
570(defface org-extra-emphasis-12
571 '((t (:inherit org-extra-emphasis)))
572 "A face for Org Extra Emphasis."
573 :group 'org-extra-emphasis-faces)
574
575(defface org-extra-emphasis-13
576 '((t (:inherit org-extra-emphasis)))
577 "A face for Org Extra Emphasis."
578 :group 'org-extra-emphasis-faces)
579
580(defface org-extra-emphasis-14
581 '((t (:inherit org-extra-emphasis)))
582 "A face for Org Extra Emphasis."
583 :group 'org-extra-emphasis-faces)
584
585(defface org-extra-emphasis-15
586 '((t (:inherit org-extra-emphasis)))
587 "A face for Org Extra Emphasis."
588 :group 'org-extra-emphasis-faces)
589
590(defface org-extra-emphasis-16
591 '((t (:inherit org-extra-emphasis)))
592 "A face for Org Extra Emphasis."
593 :group 'org-extra-emphasis-faces)
594
595;;;;; Useful Org Setting
596
597(setcar (last org-emphasis-regexp-components) 5)
598
599(defcustom org-extra-emphasis-alist
600 '(("!!" org-extra-emphasis-01)
601 ("!@" org-extra-emphasis-02)
602 ("!%" org-extra-emphasis-03)
603 ("!&" org-extra-emphasis-04)
604 ("@!" org-extra-emphasis-05)
605 ("@@" org-extra-emphasis-06)
606 ("@%" org-extra-emphasis-07)
607 ("@&" org-extra-emphasis-08)
608 ("%!" org-extra-emphasis-09)
609 ("%@" org-extra-emphasis-10)
610 ("%%" org-extra-emphasis-11)
611 ("%&" org-extra-emphasis-12)
612 ("&!" org-extra-emphasis-13)
613 ("&@" org-extra-emphasis-14)
614 ("&%" org-extra-emphasis-15)
615 ("&&" org-extra-emphasis-16))
616 "Alist of emphasis marker and its associated face."
617 :group 'org-extra-emphasis
618 :type '(repeat
619 (list
620 (string :tag "Emphasis Marker")
621 (face :tag "Face")))
622 :set (lambda (var val)
623 (set var val)
624 (plist-put org-extra-emphasis-info :alist val)
625 (org-extra-emphasis-update)))
626
627(defcustom org-extra-emphasis t
628 "When non-nil, enable Org Extra Emphasis."
629 :group 'org-extra-emphasis
630 :type '(boolean "Org Extra Emphasis")
631 :set (lambda (var val)
632 (set var val)
633 (plist-put org-extra-emphasis-info :enabled val)
634 (org-extra-emphasis-update)))
635
636(defcustom org-extra-emphasis-filter-functions
637 '(
638 org-export-filter-headline-functions
639 org-export-filter-paragraph-functions
640 org-export-filter-table-cell-functions
641 )
642 "List of places to which `org-extra-emphasis-plain-text-filter'
643and `org-extra-emphasis-strip-zws-maybe' hooks itself.
644
645The places should be one among the values that occur in
646`org-export-filters-alist'.
647
648By default, the list includes
649 - `org-export-filter-headline-functions'
650 - `org-export-filter-paragraph-functions'
651 - `org-export-filter-table-cell-functions',
652
653This means that text with extra emphasis which appears as plain
654text, or within headlines and table cells will be, fontified."
655 :group 'org-extra-emphasis
656 :type `(set
657 ,@(thread-last org-export-filters-alist
658 (seq-map #'cdr)
659 (seq-sort #'string<)
660 (seq-map (lambda (it)
661 (list 'const it)))))
662 :set (lambda (var value)
663 (set-default var value)
664 (org-extra-emphasis-update-filter-functions value)))
665
666;;;;; `M-x org-extra-emphasis-mode'
667
668(defun org-extra-emphasis-mode (&optional arg)
669 "Enable / Disable Org Extra Emphasis.
670
671If called interactively, toggle Extra Emphasis.
672
673When called non-interactively, enable Extra Emphasis if ARG is
674positive; disable otherwise."
675 (interactive "p")
676 (cond
677 ;; Called interactively; Toggle
678 ((called-interactively-p 'any)
679 (setq org-extra-emphasis (not org-extra-emphasis)))
680 ;; Called programatically; enable if arg >= 1
681 ((and (numberp arg)
682 (>= arg 1))
683 (setq org-extra-emphasis t))
684 ;; Otherwise, disable
685 (t
686 (setq org-extra-emphasis nil)))
687 (plist-put org-extra-emphasis-info :enabled org-extra-emphasis)
688 (org-extra-emphasis-update))
689
690;;; PART-2: `org-extra-emphasis-intraword-emphasis-mode'
691
692;;;; User options
693
694(defface org-extra-emphasis-zws-face
695 '((t (:inherit org-extra-emphasis :foreground "red")))
696 "Use this face to highlight the ZERO WIDTH SPACE character."
697 :group 'org-extra-emphasis-faces)
698
699(defcustom org-extra-emphasis-zws-display-char ?\N{SPACING UNDERSCORE}
700 "Use the glyph of this character to display ZERO WIDTH SPACE.
701
702Set this to nil, if you want the ZERO WIDTH SPACE to remain
703inconspicuous in the buffer. Note that even if ZERO WIDTH SPACE
704is inconspicuos in the buffer, the ZERO WIDTH SPACE will be
705stripped from the export output accoding to the value of
706`org-extra-emphasis-intraword-emphasis-mode'."
707 :type '(choice (const :tag "Disabled" nil)
708 (character :tag "Display ZERO WIDTH SPACE as "))
709 :group 'org-extra-emphasis)
710
711;;;; Internal Variables
712
713(defvar-local org-extra-emphasis-stashed-display-table nil
714 "Stashed value of `buffer-display-table'.
715
716This is the value of `buffer-display-table' before
717`org-extra-emphasis-intraword-emphasis-mode' is turned on in the
718buffer.
719
720Use this value to restore a buffer's `buffer-display-table' when
721`org-extra-emphasis-intraword-emphasis-mode' is turned off in the
722buffer.")
723
724;;;; `M-x org-extra-emphasis-intraword-emphasis-mode'
725
726;;;###autoload
727(define-minor-mode org-extra-emphasis-intraword-emphasis-mode
728 "Toggle intra word emphasis in `org-mode' export.
729
730When `org-extra-emphasis-intraword-emphasis-mode' is enabled:
731
732- ZERO WIDTH SPACE characters are stripped from export backends.
733- ZERO WIDTH SPACE characters are displayed using
734 `org-extra-emphasis-zws-display-char' and highlighted with
735 `org-extra-emphasis-zws-face' space.
736
737TIPS for the user:
738
7391. You can insert ZERO WIDTH SPACE using
740
741 `M-x insert-char RET ZERO WIDTH SPACE RET'
742
743 One another way is to store that the ZERO WIDTH SPACE in a
744 register, say SPC, and
745
746 (set-register ?\N{SPACE} \"\N{ZERO WIDTH SPACE}\")
747
748 and use the \\[insert-register] command on that register to insert
749 the ZERO WIDTH SPACE character.
750
7512. You can examine the presence of ZERO WIDTH SPACE character in the
752 export output by turning on the `glyphless-display-mode'."
753 :lighter " ZWS"
754 :init-value nil
755 :global t
756 :group 'org-extra-emphasis
757 (cond
758 ;; Turn ON `org-extra-emphasis-intraword-emphasis-mode'
759 (org-extra-emphasis-intraword-emphasis-mode
760 (when org-extra-emphasis-zws-display-char
761 ;; Display ZERO WIDTH CHAR in a conspicuous way.
762 (setq org-extra-emphasis-stashed-display-table (copy-sequence buffer-display-table))
763 (unless buffer-display-table
764 (setq buffer-display-table (make-display-table)))
765 (aset buffer-display-table
766 ?\N{ZERO WIDTH SPACE}
767 (vector (make-glyph-code org-extra-emphasis-zws-display-char
768 'org-extra-emphasis-zws-face)))))
769 (t
770 ;; Turn OFF `org-extra-emphasis-intraword-emphasis-mode'
771 (when org-extra-emphasis-zws-display-char
772 ;; Restore the buffer's original `buffer-display-table'.
773 (setq buffer-display-table org-extra-emphasis-stashed-display-table)))))
774
775;; Adjust `buffer-display-table' so that ZERO WIDTH SPACE characters
776;; are displayed.
777(add-hook 'org-mode-hook 'org-extra-emphasis-intraword-emphasis-mode t)
778
779;;;; Export hook to strip ZERO WIDTH SPACE
780
781(defun org-extra-emphasis-strip-zws-maybe (text _backend _info)
782 "Strip ZERO WIDTH SPACE from TEXT.
783
784If `org-extra-emphasis-intraword-emphasis-mode' is enabled, strip
785ZERO WIDTH SPACE from TEXT. Otherwise, return TEXT unmodified."
786 (cond
787 ;; `org-extra-emphasis-intraword-emphasis-mode' is ON
788 (org-extra-emphasis-intraword-emphasis-mode
789 ;; Strip ZERO WIDTH SPACE.
790 (replace-regexp-in-string
791 (rx-to-string `(one-or-more ,(char-to-string ?\N{ZERO WIDTH SPACE})))
792 "" text t t))
793 ;; `org-extra-emphasis-intraword-emphasis-mode' is OFF.
794 (t
795 ;; Nothing to do.
796 text)))
797
798;; Configure Org Export Engine to strip ZERO WIDTH SPACE, if needed.
799;; (dolist (it '(org-export-filter-table-cell-functions
800;; org-export-filter-paragraph-functions))
801;; (add-to-list it 'org-extra-emphasis-strip-zws-maybe it))
802
803(provide 'org-extra-emphasis)
804
805;;; org-extra-emphasis.el ends here