org-extra-emphasis.el (29086B)
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 235 Current 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 333 based on `org-do-emphasis-faces'. The property names and values 334 correspond to the variables used in `org-do-emphasis-faces'. Key 335 differences 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. 405 Note that TEXT is in BACKEND format. 406 407 This currently supports HTML and ODT backends. 408 409 See `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. 449 This function transcode an emphasis MARKER which is in plain text 450 format, to the BACKEND format. That is, if you use `<<' as an 451 emphasis marker, you need to search for `<<' in the 452 exported HTML file. 453 454 See `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. 466 Uses `org-extra-emphasis-formatter' to do the transcoding. 467 468 Search TEXT for one or more transcoded MARKERs, and mark it up as 469 specified 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' 643 and `org-extra-emphasis-strip-zws-maybe' hooks itself. 644 645 The places should be one among the values that occur in 646 `org-export-filters-alist'. 647 648 By default, the list includes 649 - `org-export-filter-headline-functions' 650 - `org-export-filter-paragraph-functions' 651 - `org-export-filter-table-cell-functions', 652 653 This means that text with extra emphasis which appears as plain 654 text, 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 671 If called interactively, toggle Extra Emphasis. 672 673 When called non-interactively, enable Extra Emphasis if ARG is 674 positive; 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 702 Set this to nil, if you want the ZERO WIDTH SPACE to remain 703 inconspicuous in the buffer. Note that even if ZERO WIDTH SPACE 704 is inconspicuos in the buffer, the ZERO WIDTH SPACE will be 705 stripped 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 716 This is the value of `buffer-display-table' before 717 `org-extra-emphasis-intraword-emphasis-mode' is turned on in the 718 buffer. 719 720 Use this value to restore a buffer's `buffer-display-table' when 721 `org-extra-emphasis-intraword-emphasis-mode' is turned off in the 722 buffer.") 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 730 When `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 737 TIPS for the user: 738 739 1. 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 751 2. 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 784 If `org-extra-emphasis-intraword-emphasis-mode' is enabled, strip 785 ZERO 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