markdown-mode.el (441544B)
1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2007-2023 Jason R. Blevins and markdown-mode 4 ;; contributors (see the commit log for details). 5 6 ;; Author: Jason R. Blevins <jblevins@xbeta.org> 7 ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> 8 ;; Created: May 24, 2007 9 ;; Package-Version: 20241117.1510 10 ;; Package-Revision: b8637bae0752 11 ;; Package-Requires: ((emacs "27.1")) 12 ;; Keywords: Markdown, GitHub Flavored Markdown, itex 13 ;; URL: https://jblevins.org/projects/markdown-mode/ 14 15 ;; This file is not part of GNU Emacs. 16 17 ;; This program is free software; you can redistribute it and/or modify 18 ;; it under the terms of the GNU General Public License as published by 19 ;; the Free Software Foundation, either version 3 of the License, or 20 ;; (at your option) any later version. 21 22 ;; This program is distributed in the hope that it will be useful, 23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 ;; GNU General Public License for more details. 26 27 ;; You should have received a copy of the GNU General Public License 28 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 29 30 ;;; Commentary: 31 32 ;; See the README.md file for details. 33 34 35 ;;; Code: 36 37 (require 'easymenu) 38 (require 'outline) 39 (require 'thingatpt) 40 (require 'cl-lib) 41 (require 'url-parse) 42 (require 'button) 43 (require 'color) 44 (require 'rx) 45 (require 'subr-x) 46 47 (defvar jit-lock-start) 48 (defvar jit-lock-end) 49 (defvar flyspell-generic-check-word-predicate) 50 (defvar electric-pair-pairs) 51 (defvar sh-ancestor-alist) 52 53 (declare-function project-roots "project") 54 (declare-function sh-set-shell "sh-script") 55 (declare-function mailcap-file-name-to-mime-type "mailcap") 56 (declare-function dnd-get-local-file-name "dnd") 57 58 ;; for older emacs<29 59 (declare-function mailcap-mime-type-to-extension "mailcap") 60 (declare-function file-name-with-extension "files") 61 (declare-function yank-media-handler "yank-media") 62 63 64 ;;; Constants ================================================================= 65 66 (defconst markdown-mode-version "2.7-alpha" 67 "Markdown mode version number.") 68 69 (defconst markdown-output-buffer-name "*markdown-output*" 70 "Name of temporary buffer for markdown command output.") 71 72 73 ;;; Global Variables ========================================================== 74 75 (defvar markdown-reference-label-history nil 76 "History of used reference labels.") 77 78 (defvar markdown-live-preview-mode nil 79 "Sentinel variable for command `markdown-live-preview-mode'.") 80 81 (defvar markdown-gfm-language-history nil 82 "History list of languages used in the current buffer in GFM code blocks.") 83 84 (defvar markdown-follow-link-functions nil 85 "Functions used to follow a link. 86 Each function is called with one argument, the link's URL. It 87 should return non-nil if it followed the link, or nil if not. 88 Functions are called in order until one of them returns non-nil; 89 otherwise the default link-following function is used.") 90 91 92 ;;; Customizable Variables ==================================================== 93 94 (defvar markdown-mode-hook nil 95 "Hook run when entering Markdown mode.") 96 97 (defvar markdown-before-export-hook nil 98 "Hook run before running Markdown to export XHTML output. 99 The hook may modify the buffer, which will be restored to it's 100 original state after exporting is complete.") 101 102 (defvar markdown-after-export-hook nil 103 "Hook run after XHTML output has been saved. 104 Any changes to the output buffer made by this hook will be saved.") 105 106 (defgroup markdown nil 107 "Major mode for editing text files in Markdown format." 108 :prefix "markdown-" 109 :group 'text 110 :link '(url-link "https://jblevins.org/projects/markdown-mode/")) 111 112 (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") 113 when (executable-find cmd) 114 return (file-name-nondirectory it)))) 115 (or command "markdown")) 116 "Command to run markdown." 117 :group 'markdown 118 :type '(choice (string :tag "Shell command") (repeat (string)) function)) 119 120 (defcustom markdown-command-needs-filename nil 121 "Set to non-nil if `markdown-command' does not accept input from stdin. 122 Instead, it will be passed a filename as the final command line 123 option. As a result, you will only be able to run Markdown from 124 buffers which are visiting a file." 125 :group 'markdown 126 :type 'boolean) 127 128 (defcustom markdown-open-command nil 129 "Command used for opening Markdown files directly. 130 For example, a standalone Markdown previewer. This command will 131 be called with a single argument: the filename of the current 132 buffer. It can also be a function, which will be called without 133 arguments." 134 :group 'markdown 135 :type '(choice file function (const :tag "None" nil))) 136 137 (defcustom markdown-open-image-command nil 138 "Command used for opening image files directly. 139 This is used at `markdown-follow-link-at-point'." 140 :group 'markdown 141 :type '(choice file function (const :tag "None" nil))) 142 143 (defcustom markdown-hr-strings 144 '("-------------------------------------------------------------------------------" 145 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" 146 "---------------------------------------" 147 "* * * * * * * * * * * * * * * * * * * *" 148 "---------" 149 "* * * * *") 150 "Strings to use when inserting horizontal rules. 151 The first string in the list will be the default when inserting a 152 horizontal rule. Strings should be listed in decreasing order of 153 prominence (as in headings from level one to six) for use with 154 promotion and demotion functions." 155 :group 'markdown 156 :type '(repeat string)) 157 158 (defcustom markdown-bold-underscore nil 159 "Use two underscores when inserting bold text instead of two asterisks." 160 :group 'markdown 161 :type 'boolean) 162 163 (defcustom markdown-italic-underscore nil 164 "Use underscores when inserting italic text instead of asterisks." 165 :group 'markdown 166 :type 'boolean) 167 168 (defcustom markdown-marginalize-headers nil 169 "When non-nil, put opening atx header markup in a left margin. 170 171 This setting goes well with `markdown-asymmetric-header'. But 172 sadly it conflicts with `linum-mode' since they both use the 173 same margin." 174 :group 'markdown 175 :type 'boolean 176 :safe 'booleanp 177 :package-version '(markdown-mode . "2.4")) 178 179 (defcustom markdown-marginalize-headers-margin-width 6 180 "Character width of margin used for marginalized headers. 181 The default value is based on there being six heading levels 182 defined by Markdown and HTML. Increasing this produces extra 183 whitespace on the left. Decreasing it may be preferred when 184 fewer than six nested heading levels are used." 185 :group 'markdown 186 :type 'integer 187 :safe 'natnump 188 :package-version '(markdown-mode . "2.4")) 189 190 (defcustom markdown-asymmetric-header nil 191 "Determines if atx header style will be asymmetric. 192 Set to a non-nil value to use asymmetric header styling, placing 193 header markup only at the beginning of the line. By default, 194 balanced markup will be inserted at the beginning and end of the 195 line around the header title." 196 :group 'markdown 197 :type 'boolean) 198 199 (defcustom markdown-indent-function 'markdown-indent-line 200 "Function to use to indent." 201 :group 'markdown 202 :type 'function) 203 204 (defcustom markdown-indent-on-enter t 205 "Determines indentation behavior when pressing \\[newline]. 206 Possible settings are nil, t, and \\='indent-and-new-item. 207 208 When non-nil, pressing \\[newline] will call `newline-and-indent' 209 to indent the following line according to the context using 210 `markdown-indent-function'. In this case, note that 211 \\[electric-newline-and-maybe-indent] can still be used to insert 212 a newline without indentation. 213 214 When set to \\='indent-and-new-item and the point is in a list item 215 when \\[newline] is pressed, the list will be continued on the next 216 line, where a new item will be inserted. 217 218 When set to nil, simply call `newline' as usual. In this case, 219 you can still indent lines using \\[markdown-cycle] and continue 220 lists with \\[markdown-insert-list-item]. 221 222 Note that this assumes the variable `electric-indent-mode' is 223 non-nil (enabled). When it is *disabled*, the behavior of 224 \\[newline] and `\\[electric-newline-and-maybe-indent]' are 225 reversed." 226 :group 'markdown 227 :type '(choice (const :tag "Don't automatically indent" nil) 228 (const :tag "Automatically indent" t) 229 (const :tag "Automatically indent and insert new list items" indent-and-new-item))) 230 231 (defcustom markdown-enable-wiki-links nil 232 "Syntax highlighting for wiki links. 233 Set this to a non-nil value to turn on wiki link support by default. 234 Support can be toggled later using the `markdown-toggle-wiki-links' 235 function or \\[markdown-toggle-wiki-links]." 236 :group 'markdown 237 :type 'boolean 238 :safe 'booleanp 239 :package-version '(markdown-mode . "2.2")) 240 241 (defcustom markdown-wiki-link-alias-first t 242 "When non-nil, treat aliased wiki links like [[alias text|PageName]]. 243 Otherwise, they will be treated as [[PageName|alias text]]." 244 :group 'markdown 245 :type 'boolean 246 :safe 'booleanp) 247 248 (defcustom markdown-wiki-link-search-subdirectories nil 249 "When non-nil, search for wiki link targets in subdirectories. 250 This is the default search behavior for GitHub and is 251 automatically set to t in `gfm-mode'." 252 :group 'markdown 253 :type 'boolean 254 :safe 'booleanp 255 :package-version '(markdown-mode . "2.2")) 256 257 (defcustom markdown-wiki-link-search-parent-directories nil 258 "When non-nil, search for wiki link targets in parent directories. 259 This is the default search behavior of Ikiwiki." 260 :group 'markdown 261 :type 'boolean 262 :safe 'booleanp 263 :package-version '(markdown-mode . "2.2")) 264 265 (defcustom markdown-wiki-link-search-type nil 266 "Searching type for markdown wiki link. 267 268 sub-directories: search for wiki link targets in sub directories 269 parent-directories: search for wiki link targets in parent directories 270 project: search for wiki link targets under project root" 271 :group 'markdown 272 :type '(set 273 (const :tag "search wiki link from subdirectories" sub-directories) 274 (const :tag "search wiki link from parent directories" parent-directories) 275 (const :tag "search wiki link under project root" project)) 276 :package-version '(markdown-mode . "2.5")) 277 278 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") 279 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") 280 281 (defcustom markdown-wiki-link-fontify-missing nil 282 "When non-nil, change wiki link face according to existence of target files. 283 This is expensive because it requires checking for the file each time the buffer 284 changes or the user switches windows. It is disabled by default because it may 285 cause lag when typing on slower machines." 286 :group 'markdown 287 :type 'boolean 288 :safe 'booleanp 289 :package-version '(markdown-mode . "2.2")) 290 291 (defcustom markdown-uri-types 292 '("acap" "cid" "data" "dav" "fax" "file" "ftp" 293 "geo" "gopher" "http" "https" "imap" "ldap" "mailto" 294 "mid" "message" "modem" "news" "nfs" "nntp" 295 "pop" "prospero" "rtsp" "service" "sip" "tel" 296 "telnet" "tip" "urn" "vemmi" "wais") 297 "Link types for syntax highlighting of URIs." 298 :group 'markdown 299 :type '(repeat (string :tag "URI scheme"))) 300 301 (defcustom markdown-url-compose-char 302 '(?∞ ?… ?⋯ ?# ?★ ?⚓) 303 "Placeholder character for hidden URLs. 304 This may be a single character or a list of characters. In case 305 of a list, the first one that satisfies `char-displayable-p' will 306 be used." 307 :type '(choice 308 (character :tag "Single URL replacement character") 309 (repeat :tag "List of possible URL replacement characters" 310 character)) 311 :package-version '(markdown-mode . "2.3")) 312 313 (defcustom markdown-blockquote-display-char 314 '("▌" "┃" ">") 315 "String to display when hiding blockquote markup. 316 This may be a single string or a list of string. In case of a 317 list, the first one that satisfies `char-displayable-p' will be 318 used." 319 :type '(choice 320 (string :tag "Single blockquote display string") 321 (repeat :tag "List of possible blockquote display strings" string)) 322 :package-version '(markdown-mode . "2.3")) 323 324 (defcustom markdown-hr-display-char 325 '(?─ ?━ ?-) 326 "Character for hiding horizontal rule markup. 327 This may be a single character or a list of characters. In case 328 of a list, the first one that satisfies `char-displayable-p' will 329 be used." 330 :group 'markdown 331 :type '(choice 332 (character :tag "Single HR display character") 333 (repeat :tag "List of possible HR display characters" character)) 334 :package-version '(markdown-mode . "2.3")) 335 336 (defcustom markdown-definition-display-char 337 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) 338 "Character for replacing definition list markup. 339 This may be a single character or a list of characters. In case 340 of a list, the first one that satisfies `char-displayable-p' will 341 be used." 342 :type '(choice 343 (character :tag "Single definition list character") 344 (repeat :tag "List of possible definition list characters" character)) 345 :package-version '(markdown-mode . "2.3")) 346 347 (defcustom markdown-enable-math nil 348 "Syntax highlighting for inline LaTeX and itex expressions. 349 Set this to a non-nil value to turn on math support by default. 350 Math support can be enabled, disabled, or toggled later using 351 `markdown-toggle-math' or \\[markdown-toggle-math]." 352 :group 'markdown 353 :type 'boolean 354 :safe 'booleanp) 355 (make-variable-buffer-local 'markdown-enable-math) 356 357 (defcustom markdown-enable-html t 358 "Enable font-lock support for HTML tags and attributes." 359 :group 'markdown 360 :type 'boolean 361 :safe 'booleanp 362 :package-version '(markdown-mode . "2.4")) 363 364 (defcustom markdown-enable-highlighting-syntax nil 365 "Enable highlighting syntax." 366 :group 'markdown 367 :type 'boolean 368 :safe 'booleanp 369 :package-version '(markdown-mode . "2.5")) 370 371 (defcustom markdown-css-paths nil 372 "List of URLs of CSS files to link to in the output XHTML." 373 :group 'markdown 374 :safe (lambda (x) (and (listp x) (cl-every #'stringp x))) 375 :type '(repeat (string :tag "CSS File Path"))) 376 377 (defcustom markdown-content-type "text/html" 378 "Content type string for the http-equiv header in XHTML output. 379 When set to an empty string, this attribute is omitted. Defaults to 380 `text/html'." 381 :group 'markdown 382 :type 'string) 383 384 (defcustom markdown-coding-system nil 385 "Character set string for the http-equiv header in XHTML output. 386 Defaults to `buffer-file-coding-system' (and falling back to 387 `utf-8' when not available). Common settings are `iso-8859-1' 388 and `iso-latin-1'. Use `list-coding-systems' for more choices." 389 :group 'markdown 390 :type 'coding-system) 391 392 (defcustom markdown-export-kill-buffer t 393 "Kill output buffer after HTML export. 394 When non-nil, kill the HTML output buffer after 395 exporting with `markdown-export'." 396 :group 'markdown 397 :type 'boolean 398 :safe 'booleanp 399 :package-version '(markdown-mode . "2.4")) 400 401 (defcustom markdown-xhtml-header-content "" 402 "Additional content to include in the XHTML <head> block." 403 :group 'markdown 404 :type 'string) 405 406 (defcustom markdown-xhtml-body-preamble "" 407 "Content to include in the XHTML <body> block, before the output." 408 :group 'markdown 409 :type 'string 410 :safe 'stringp 411 :package-version '(markdown-mode . "2.4")) 412 413 (defcustom markdown-xhtml-body-epilogue "" 414 "Content to include in the XHTML <body> block, after the output." 415 :group 'markdown 416 :type 'string 417 :safe 'stringp 418 :package-version '(markdown-mode . "2.4")) 419 420 (defcustom markdown-xhtml-standalone-regexp 421 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" 422 "Regexp indicating whether `markdown-command' output is standalone XHTML." 423 :group 'markdown 424 :type 'regexp) 425 426 (defcustom markdown-link-space-sub-char "_" 427 "Character to use instead of spaces when mapping wiki links to filenames." 428 :group 'markdown 429 :type 'string) 430 431 (defcustom markdown-reference-location 'header 432 "Position where new reference definitions are inserted in the document." 433 :group 'markdown 434 :type '(choice (const :tag "At the end of the document" end) 435 (const :tag "Immediately after the current block" immediately) 436 (const :tag "At the end of the subtree" subtree) 437 (const :tag "Before next header" header))) 438 439 (defcustom markdown-footnote-location 'end 440 "Position where new footnotes are inserted in the document." 441 :group 'markdown 442 :type '(choice (const :tag "At the end of the document" end) 443 (const :tag "Immediately after the current block" immediately) 444 (const :tag "At the end of the subtree" subtree) 445 (const :tag "Before next header" header))) 446 447 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) 448 "Display specification for footnote markers and inline footnotes. 449 By default, footnote text is reduced in size and raised. Set to 450 nil to disable this." 451 :group 'markdown 452 :type '(choice (sexp :tag "Display specification") 453 (const :tag "Don't set display property" nil)) 454 :package-version '(markdown-mode . "2.4")) 455 456 (defcustom markdown-sub-superscript-display 457 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) 458 "Display specification for subscript and superscripts. 459 The car is used for subscript, the cdr is used for superscripts." 460 :group 'markdown 461 :type '(cons (choice (sexp :tag "Subscript form") 462 (const :tag "No lowering" nil)) 463 (choice (sexp :tag "Superscript form") 464 (const :tag "No raising" nil))) 465 :package-version '(markdown-mode . "2.4")) 466 467 (defcustom markdown-unordered-list-item-prefix " * " 468 "String inserted before unordered list items." 469 :group 'markdown 470 :type 'string) 471 472 (defcustom markdown-ordered-list-enumeration t 473 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. 474 While nil, always uses '1.' for the marker" 475 :group 'markdown 476 :type 'boolean 477 :package-version '(markdown-mode . "2.5")) 478 479 (defcustom markdown-nested-imenu-heading-index t 480 "Use nested or flat imenu heading index. 481 A nested index may provide more natural browsing from the menu, 482 but a flat list may allow for faster keyboard navigation via tab 483 completion." 484 :group 'markdown 485 :type 'boolean 486 :safe 'booleanp 487 :package-version '(markdown-mode . "2.2")) 488 489 (defcustom markdown-add-footnotes-to-imenu t 490 "Add footnotes to end of imenu heading index." 491 :group 'markdown 492 :type 'boolean 493 :safe 'booleanp 494 :package-version '(markdown-mode . "2.4")) 495 496 (defcustom markdown-make-gfm-checkboxes-buttons t 497 "When non-nil, make GFM checkboxes into buttons." 498 :group 'markdown 499 :type 'boolean) 500 501 (defcustom markdown-use-pandoc-style-yaml-metadata nil 502 "When non-nil, allow YAML metadata anywhere in the document." 503 :group 'markdown 504 :type 'boolean) 505 506 (defcustom markdown-split-window-direction 'any 507 "Preference for splitting windows for static and live preview. 508 The default value is \\='any, which instructs Emacs to use 509 `split-window-sensibly' to automatically choose how to split 510 windows based on the values of `split-width-threshold' and 511 `split-height-threshold' and the available windows. To force 512 vertically split (left and right) windows, set this to \\='vertical 513 or \\='right. To force horizontally split (top and bottom) windows, 514 set this to \\='horizontal or \\='below. 515 516 If this value is \\='any and `display-buffer-alist' is set then 517 `display-buffer' is used for open buffer function" 518 :group 'markdown 519 :type '(choice (const :tag "Automatic" any) 520 (const :tag "Right (vertical)" right) 521 (const :tag "Below (horizontal)" below)) 522 :package-version '(markdown-mode . "2.2")) 523 524 (defcustom markdown-live-preview-window-function 525 #'markdown-live-preview-window-eww 526 "Function to display preview of Markdown output within Emacs. 527 Function must update the buffer containing the preview and return 528 the buffer." 529 :group 'markdown 530 :type 'function) 531 532 (defcustom markdown-live-preview-delete-export 'delete-on-destroy 533 "Delete exported HTML file when using `markdown-live-preview-export'. 534 If set to \\='delete-on-export, delete on every export. When set to 535 \\='delete-on-destroy delete when quitting from command 536 `markdown-live-preview-mode'. Never delete if set to nil." 537 :group 'markdown 538 :type '(choice 539 (const :tag "Delete on every export" delete-on-export) 540 (const :tag "Delete when quitting live preview" delete-on-destroy) 541 (const :tag "Never delete" nil))) 542 543 (defcustom markdown-list-indent-width 4 544 "Depth of indentation for markdown lists. 545 Used in `markdown-demote-list-item' and 546 `markdown-promote-list-item'." 547 :group 'markdown 548 :type 'integer) 549 550 (defcustom markdown-enable-prefix-prompts t 551 "Display prompts for certain prefix commands. 552 Set to nil to disable these prompts." 553 :group 'markdown 554 :type 'boolean 555 :safe 'booleanp 556 :package-version '(markdown-mode . "2.3")) 557 558 (defcustom markdown-gfm-additional-languages nil 559 "Extra languages made available when inserting GFM code blocks. 560 Language strings must have be trimmed of whitespace and not 561 contain any curly braces. They may be of arbitrary 562 capitalization, though." 563 :group 'markdown 564 :type '(repeat (string :validate markdown-validate-language-string))) 565 566 (defcustom markdown-gfm-use-electric-backquote t 567 "Use `markdown-electric-backquote' when backquote is hit three times." 568 :group 'markdown 569 :type 'boolean) 570 571 (defcustom markdown-gfm-downcase-languages t 572 "If non-nil, downcase suggested languages. 573 This applies to insertions done with 574 `markdown-electric-backquote'." 575 :group 'markdown 576 :type 'boolean) 577 578 (defcustom markdown-edit-code-block-default-mode 'normal-mode 579 "Default mode to use for editing code blocks. 580 This mode is used when automatic detection fails, such as for GFM 581 code blocks with no language specified." 582 :group 'markdown 583 :type '(choice function (const :tag "None" nil)) 584 :package-version '(markdown-mode . "2.4")) 585 586 (defcustom markdown-gfm-uppercase-checkbox nil 587 "If non-nil, use [X] for completed checkboxes, [x] otherwise." 588 :group 'markdown 589 :type 'boolean 590 :safe 'booleanp) 591 592 (defcustom markdown-hide-urls nil 593 "Hide URLs of inline links and reference tags of reference links. 594 Such URLs will be replaced by a single customizable 595 character, defined by `markdown-url-compose-char', but are still part 596 of the buffer. Links can be edited interactively with 597 \\[markdown-insert-link] or, for example, by deleting the final 598 parenthesis to remove the invisibility property. You can also 599 hover your mouse pointer over the link text to see the URL. 600 Set this to a non-nil value to turn this feature on by default. 601 You can interactively set the value of this variable by calling 602 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], 603 or from the menu Markdown > Links & Images menu." 604 :group 'markdown 605 :type 'boolean 606 :safe 'booleanp 607 :package-version '(markdown-mode . "2.3")) 608 (make-variable-buffer-local 'markdown-hide-urls) 609 610 (defcustom markdown-translate-filename-function #'identity 611 "Function to use to translate filenames when following links. 612 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] 613 call this function with the filename as only argument whenever 614 they encounter a filename (instead of a URL) to be visited and 615 use its return value instead of the filename in the link. For 616 example, if absolute filenames are actually relative to a server 617 root directory, you can set 618 `markdown-translate-filename-function' to a function that 619 prepends the root directory to the given filename." 620 :group 'markdown 621 :type 'function 622 :risky t 623 :package-version '(markdown-mode . "2.4")) 624 625 (defcustom markdown-max-image-size nil 626 "Maximum width and height for displayed inline images. 627 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). 628 When nil, use the actual size. Otherwise, use ImageMagick to 629 resize larger images to be of the given maximum dimensions. This 630 requires Emacs to be built with ImageMagick support." 631 :group 'markdown 632 :package-version '(markdown-mode . "2.4") 633 :type '(choice 634 (const :tag "Use actual image width" nil) 635 (cons (choice (sexp :tag "Maximum width in pixels") 636 (const :tag "No maximum width" nil)) 637 (choice (sexp :tag "Maximum height in pixels") 638 (const :tag "No maximum height" nil))))) 639 640 (defcustom markdown-mouse-follow-link t 641 "Non-nil means mouse on a link will follow the link. 642 This variable must be set before loading markdown-mode." 643 :group 'markdown 644 :type 'boolean 645 :safe 'booleanp 646 :package-version '(markdown-mode . "2.5")) 647 648 (defcustom markdown-table-align-p t 649 "Non-nil means that table is aligned after table operation." 650 :group 'markdown 651 :type 'boolean 652 :safe 'booleanp 653 :package-version '(markdown-mode . "2.5")) 654 655 (defcustom markdown-fontify-whole-heading-line nil 656 "Non-nil means fontify the whole line for headings. 657 This is useful when setting a background color for the 658 markdown-header-face-* faces." 659 :group 'markdown 660 :type 'boolean 661 :safe 'booleanp 662 :package-version '(markdown-mode . "2.5")) 663 664 (defcustom markdown-special-ctrl-a/e nil 665 "Non-nil means `C-a' and `C-e' behave specially in headlines and items. 666 667 When t, `C-a' will bring back the cursor to the beginning of the 668 headline text. In an item, this will be the position after bullet 669 and check-box, if any. When the cursor is already at that 670 position, another `C-a' will bring it to the beginning of the 671 line. 672 673 `C-e' will jump to the end of the headline, ignoring the presence 674 of closing tags in the headline. A second `C-e' will then jump to 675 the true end of the line, after closing tags. This also means 676 that, when this variable is non-nil, `C-e' also will never jump 677 beyond the end of the heading of a folded section, i.e. not after 678 the ellipses. 679 680 When set to the symbol `reversed', the first `C-a' or `C-e' works 681 normally, going to the true line boundary first. Only a directly 682 following, identical keypress will bring the cursor to the 683 special positions. 684 685 This may also be a cons cell where the behavior for `C-a' and 686 `C-e' is set separately." 687 :group 'markdown 688 :type '(choice 689 (const :tag "off" nil) 690 (const :tag "on: after hashes/bullet and before closing tags first" t) 691 (const :tag "reversed: true line boundary first" reversed) 692 (cons :tag "Set C-a and C-e separately" 693 (choice :tag "Special C-a" 694 (const :tag "off" nil) 695 (const :tag "on: after hashes/bullet first" t) 696 (const :tag "reversed: before hashes/bullet first" reversed)) 697 (choice :tag "Special C-e" 698 (const :tag "off" nil) 699 (const :tag "on: before closing tags first" t) 700 (const :tag "reversed: after closing tags first" reversed)))) 701 :package-version '(markdown-mode . "2.7")) 702 703 ;;; Markdown-Specific `rx' Macro ============================================== 704 705 ;; Based on python-rx from python.el. 706 (defmacro markdown-rx (&rest regexps) 707 "Markdown mode specialized rx macro. 708 This variant of `rx' supports common Markdown named REGEXPS." 709 `(rx-let ((newline "\n") 710 ;; Note: #405 not consider markdown-list-indent-width however this is never used 711 (indent (or (repeat 4 " ") "\t")) 712 (block-end (and (or (one-or-more (zero-or-more blank) "\n") line-end))) 713 (numeral (and (one-or-more (any "0-9#")) ".")) 714 (bullet (any "*+:-")) 715 (list-marker (or (and (one-or-more (any "0-9#")) ".") 716 (any "*+:-"))) 717 (checkbox (seq "[" (any " xX") "]"))) 718 (rx ,@regexps))) 719 720 721 ;;; Regular Expressions ======================================================= 722 723 (defconst markdown-regex-comment-start 724 "<!--" 725 "Regular expression matches HTML comment opening.") 726 727 (defconst markdown-regex-comment-end 728 "--[ \t]*>" 729 "Regular expression matches HTML comment closing.") 730 731 (defconst markdown-regex-link-inline 732 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" 733 "Regular expression for a [text](file) or an image link ![text](file). 734 Group 1 matches the leading exclamation point (optional). 735 Group 2 matches the opening square bracket. 736 Group 3 matches the text inside the square brackets. 737 Group 4 matches the closing square bracket. 738 Group 5 matches the opening parenthesis. 739 Group 6 matches the URL. 740 Group 7 matches the title (optional). 741 Group 8 matches the closing parenthesis.") 742 743 (defconst markdown-regex-link-reference 744 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" 745 "Regular expression for a reference link [text][id]. 746 Group 1 matches the leading exclamation point (optional). 747 Group 2 matches the opening square bracket for the link text. 748 Group 3 matches the text inside the square brackets. 749 Group 4 matches the closing square bracket for the link text. 750 Group 5 matches the opening square bracket for the reference label. 751 Group 6 matches the reference label. 752 Group 7 matches the closing square bracket for the reference label.") 753 754 (defconst markdown-regex-reference-definition 755 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" 756 "Regular expression for a reference definition. 757 Group 1 matches the opening square bracket. 758 Group 2 matches the reference label. 759 Group 3 matches the closing square bracket. 760 Group 4 matches the colon. 761 Group 5 matches the URL. 762 Group 6 matches the title attribute (optional).") 763 764 (defconst markdown-regex-footnote 765 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" 766 "Regular expression for a footnote marker [^fn]. 767 Group 1 matches the opening square bracket and carat. 768 Group 2 matches only the label, without the surrounding markup. 769 Group 3 matches the closing square bracket.") 770 771 (defconst markdown-regex-header 772 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" 773 "Regexp identifying Markdown headings. 774 Group 1 matches the text of a setext heading. 775 Group 2 matches the underline of a level-1 setext heading. 776 Group 3 matches the underline of a level-2 setext heading. 777 Group 4 matches the opening hash marks of an atx heading and whitespace. 778 Group 5 matches the text, without surrounding whitespace, of an atx heading. 779 Group 6 matches the closing whitespace and hash marks of an atx heading.") 780 781 (defconst markdown-regex-header-setext 782 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" 783 "Regular expression for generic setext-style (underline) headers.") 784 785 (defconst markdown-regex-header-atx 786 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" 787 "Regular expression for generic atx-style (hash mark) headers.") 788 789 (defconst markdown-regex-hr 790 (rx line-start 791 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) 792 (and (repeat 3 (and "-" (? " "))) (* (any "- "))) 793 (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) 794 line-end) 795 "Regular expression for matching Markdown horizontal rules.") 796 797 (defconst markdown-regex-code 798 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" 799 "Regular expression for matching inline code fragments. 800 801 Group 1 matches the entire code fragment including the backquotes. 802 Group 2 matches the opening backquotes. 803 Group 3 matches the code fragment itself, without backquotes. 804 Group 4 matches the closing backquotes. 805 806 The leading, unnumbered group ensures that the leading backquote 807 character is not escaped. 808 The last group, also unnumbered, requires that the character 809 following the code fragment is not a backquote. 810 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, 811 but not two newlines in a row.") 812 813 (defconst markdown-regex-kbd 814 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" 815 "Regular expression for matching <kbd> tags. 816 Groups 1 and 3 match the opening and closing tags. 817 Group 2 matches the key sequence.") 818 819 (defconst markdown-regex-gfm-code-block-open 820 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" 821 "Regular expression matching opening of GFM code blocks. 822 Group 1 matches the opening three backquotes and any following whitespace. 823 Group 2 matches the opening brace (optional) and surrounding whitespace. 824 Group 3 matches the language identifier (optional). 825 Group 4 matches the info string (optional). 826 Group 5 matches the closing brace (optional), whitespace, and newline. 827 Groups need to agree with `markdown-regex-tilde-fence-begin'.") 828 829 (defconst markdown-regex-gfm-code-block-close 830 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" 831 "Regular expression matching closing of GFM code blocks. 832 Group 1 matches the closing three backquotes. 833 Group 2 matches any whitespace and the final newline.") 834 835 (defconst markdown-regex-pre 836 "^\\( \\|\t\\).*$" 837 "Regular expression for matching preformatted text sections.") 838 839 (defconst markdown-regex-list 840 (markdown-rx line-start 841 ;; 1. Leading whitespace 842 (group (* blank)) 843 ;; 2. List marker: a numeral, bullet, or colon 844 (group list-marker) 845 ;; 3. Trailing whitespace 846 (group (+ blank)) 847 ;; 4. Optional checkbox for GFM task list items 848 (opt (group (and checkbox (* blank))))) 849 "Regular expression for matching list items.") 850 851 (defconst markdown-regex-bold 852 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" 853 "Regular expression for matching bold text. 854 Group 1 matches the character before the opening asterisk or 855 underscore, if any, ensuring that it is not a backslash escape. 856 Group 2 matches the entire expression, including delimiters. 857 Groups 3 and 5 matches the opening and closing delimiters. 858 Group 4 matches the text inside the delimiters.") 859 860 (defconst markdown-regex-italic 861 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" 862 "Regular expression for matching italic text. 863 The leading unnumbered matches the character before the opening 864 asterisk or underscore, if any, ensuring that it is not a 865 backslash escape. 866 Group 1 matches the entire expression, including delimiters. 867 Groups 2 and 4 matches the opening and closing delimiters. 868 Group 3 matches the text inside the delimiters.") 869 870 (defconst markdown-regex-strike-through 871 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" 872 "Regular expression for matching strike-through text. 873 Group 1 matches the character before the opening tilde, if any, 874 ensuring that it is not a backslash escape. 875 Group 2 matches the entire expression, including delimiters. 876 Groups 3 and 5 matches the opening and closing delimiters. 877 Group 4 matches the text inside the delimiters.") 878 879 (defconst markdown-regex-gfm-italic 880 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" 881 "Regular expression for matching italic text in GitHub Flavored Markdown. 882 Underscores in words are not treated as special. 883 Group 1 matches the entire expression, including delimiters. 884 Groups 2 and 4 matches the opening and closing delimiters. 885 Group 3 matches the text inside the delimiters.") 886 887 (defconst markdown-regex-blockquote 888 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" 889 "Regular expression for matching blockquote lines. 890 Also accounts for a potential capital letter preceding the angle 891 bracket, for use with Leanpub blocks (asides, warnings, info 892 blocks, etc.). 893 Group 1 matches the leading angle bracket. 894 Group 2 matches the separating whitespace. 895 Group 3 matches the text.") 896 897 (defconst markdown-regex-line-break 898 "[^ \n\t][ \t]*\\( \\)\n" 899 "Regular expression for matching line breaks.") 900 901 (defconst markdown-regex-escape 902 "\\(\\\\\\)." 903 "Regular expression for matching escape sequences.") 904 905 (defconst markdown-regex-wiki-link 906 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" 907 "Regular expression for matching wiki links. 908 This matches typical bracketed [[WikiLinks]] as well as \\='aliased 909 wiki links of the form [[PageName|link text]]. 910 The meanings of the first and second components depend 911 on the value of `markdown-wiki-link-alias-first'. 912 913 Group 1 matches the entire link. 914 Group 2 matches the opening square brackets. 915 Group 3 matches the first component of the wiki link. 916 Group 4 matches the pipe separator, when present. 917 Group 5 matches the second component of the wiki link, when present. 918 Group 6 matches the closing square brackets.") 919 920 (defconst markdown-regex-uri 921 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") 922 "Regular expression for matching inline URIs.") 923 924 ;; CommanMark specification says scheme length is 2-32 characters 925 (defconst markdown-regex-angle-uri 926 (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") 927 "Regular expression for matching inline URIs in angle brackets.") 928 929 (defconst markdown-regex-email 930 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" 931 "Regular expression for matching inline email addresses.") 932 933 (defsubst markdown-make-regex-link-generic () 934 "Make regular expression for matching any recognized link." 935 (concat "\\(?:" markdown-regex-link-inline 936 (when markdown-enable-wiki-links 937 (concat "\\|" markdown-regex-wiki-link)) 938 "\\|" markdown-regex-link-reference 939 "\\|" markdown-regex-angle-uri "\\)")) 940 941 (defconst markdown-regex-gfm-checkbox 942 " \\(\\[[ xX]\\]\\) " 943 "Regular expression for matching GFM checkboxes. 944 Group 1 matches the text to become a button.") 945 946 (defconst markdown-regex-blank-line 947 "^[[:blank:]]*$" 948 "Regular expression that matches a blank line.") 949 950 (defconst markdown-regex-block-separator 951 "\n[\n\t\f ]*\n" 952 "Regular expression for matching block boundaries.") 953 954 (defconst markdown-regex-block-separator-noindent 955 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") 956 "Regexp for block separators before lines with no indentation.") 957 958 (defconst markdown-regex-math-inline-single 959 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" 960 "Regular expression for itex $..$ math mode expressions. 961 Groups 1 and 3 match the opening and closing dollar signs. 962 Group 2 matches the mathematical expression contained within.") 963 964 (defconst markdown-regex-math-inline-double 965 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" 966 "Regular expression for itex $$..$$ math mode expressions. 967 Groups 1 and 3 match opening and closing dollar signs. 968 Group 2 matches the mathematical expression contained within.") 969 970 (defconst markdown-regex-math-display 971 (rx line-start (* blank) 972 (group (group (repeat 1 2 "\\")) "[") 973 (group (*? anything)) 974 (group (backref 2) "]") 975 line-end) 976 "Regular expression for \[..\] or \\[..\\] display math. 977 Groups 1 and 4 match the opening and closing markup. 978 Group 3 matches the mathematical expression contained within. 979 Group 2 matches the opening slashes, and is used internally to 980 match the closing slashes.") 981 982 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) 983 "Return regexp matching a tilde code fence at least NUM-TILDES long. 984 END-OF-LINE is the regexp construct to indicate end of line; $ if 985 missing." 986 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" 987 (or end-of-line "$"))) 988 989 (defconst markdown-regex-tilde-fence-begin 990 (markdown-make-tilde-fence-regex 991 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") 992 "Regular expression for matching tilde-fenced code blocks. 993 Group 1 matches the opening tildes. 994 Group 2 matches (optional) opening brace and surrounding whitespace. 995 Group 3 matches the language identifier (optional). 996 Group 4 matches the info string (optional). 997 Group 5 matches the closing brace (optional) and any surrounding whitespace. 998 Groups need to agree with `markdown-regex-gfm-code-block-open'.") 999 1000 (defconst markdown-regex-declarative-metadata 1001 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" 1002 "Regular expression for matching declarative metadata statements. 1003 This matches MultiMarkdown metadata as well as YAML and TOML 1004 assignments such as the following: 1005 1006 variable: value 1007 1008 or 1009 1010 variable = value") 1011 1012 (defconst markdown-regex-pandoc-metadata 1013 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" 1014 "Regular expression for matching Pandoc metadata.") 1015 1016 (defconst markdown-regex-yaml-metadata-border 1017 "\\(-\\{3\\}\\)$" 1018 "Regular expression for matching YAML metadata.") 1019 1020 (defconst markdown-regex-yaml-pandoc-metadata-end-border 1021 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" 1022 "Regular expression for matching YAML metadata end borders.") 1023 1024 (defsubst markdown-get-yaml-metadata-start-border () 1025 "Return YAML metadata start border depending upon whether Pandoc is used." 1026 (concat 1027 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") 1028 markdown-regex-yaml-metadata-border)) 1029 1030 (defsubst markdown-get-yaml-metadata-end-border (_) 1031 "Return YAML metadata end border depending upon whether Pandoc is used." 1032 (if markdown-use-pandoc-style-yaml-metadata 1033 markdown-regex-yaml-pandoc-metadata-end-border 1034 markdown-regex-yaml-metadata-border)) 1035 1036 (defconst markdown-regex-inline-attributes 1037 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" 1038 "Regular expression for matching inline identifiers or attribute lists. 1039 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") 1040 1041 (defconst markdown-regex-leanpub-sections 1042 (concat 1043 "^\\({\\)\\(" 1044 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) 1045 "\\)\\(}\\)[ \t]*\n") 1046 "Regular expression for Leanpub section markers and related syntax.") 1047 1048 (defconst markdown-regex-sub-superscript 1049 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" 1050 "The regular expression matching a sub- or superscript. 1051 The leading un-numbered group matches the character before the 1052 opening tilde or carat, if any, ensuring that it is not a 1053 backslash escape, carat, or tilde. 1054 Group 1 matches the entire expression, including markup. 1055 Group 2 matches the opening markup--a tilde or carat. 1056 Group 3 matches the text inside the delimiters. 1057 Group 4 matches the closing markup--a tilde or carat.") 1058 1059 (defconst markdown-regex-include 1060 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" 1061 "Regular expression matching common forms of include syntax. 1062 Marked 2, Leanpub, and other processors support some of these forms: 1063 1064 <<[sections/section1.md] 1065 <<(folder/filename) 1066 <<[Code title](folder/filename) 1067 <<{folder/raw_file.html} 1068 1069 Group 1 matches the opening two angle brackets. 1070 Groups 2-4 match the opening square bracket, the text inside, 1071 and the closing square bracket, respectively. 1072 Groups 5-7 match the opening parenthesis, the text inside, and 1073 the closing parenthesis. 1074 Groups 8-10 match the opening brace, the text inside, and the brace.") 1075 1076 (defconst markdown-regex-pandoc-inline-footnote 1077 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" 1078 "Regular expression for Pandoc inline footnote^[footnote text]. 1079 Group 1 matches the opening caret. 1080 Group 2 matches the opening square bracket. 1081 Group 3 matches the footnote text, without the surrounding markup. 1082 Group 4 matches the closing square bracket.") 1083 1084 (defconst markdown-regex-html-attr 1085 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" 1086 "Regular expression for matching HTML attributes and values. 1087 Group 1 matches the attribute name. 1088 Group 2 matches the following whitespace, equals sign, and value, if any. 1089 Group 3 matches the equals sign, if any. 1090 Group 4 matches single-, double-, or un-quoted attribute values.") 1091 1092 (defconst markdown-regex-html-tag 1093 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr 1094 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") 1095 "Regular expression for matching HTML tags. 1096 Groups 1 and 9 match the beginning and ending angle brackets and slashes. 1097 Group 2 matches the tag name. 1098 Group 3 matches all attributes and whitespace following the tag name.") 1099 1100 (defconst markdown-regex-html-entity 1101 "\\(&#?[[:alnum:]]+;\\)" 1102 "Regular expression for matching HTML entities.") 1103 1104 (defconst markdown-regex-highlighting 1105 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" 1106 "Regular expression for matching highlighting text. 1107 Group 1 matches the character before the opening equal, if any, 1108 ensuring that it is not a backslash escape. 1109 Group 2 matches the entire expression, including delimiters. 1110 Groups 3 and 5 matches the opening and closing delimiters. 1111 Group 4 matches the text inside the delimiters.") 1112 1113 1114 ;;; Syntax ==================================================================== 1115 1116 (defvar markdown--syntax-properties 1117 (list 'markdown-tilde-fence-begin nil 1118 'markdown-tilde-fence-end nil 1119 'markdown-fenced-code nil 1120 'markdown-yaml-metadata-begin nil 1121 'markdown-yaml-metadata-end nil 1122 'markdown-yaml-metadata-section nil 1123 'markdown-gfm-block-begin nil 1124 'markdown-gfm-block-end nil 1125 'markdown-gfm-code nil 1126 'markdown-list-item nil 1127 'markdown-pre nil 1128 'markdown-blockquote nil 1129 'markdown-hr nil 1130 'markdown-comment nil 1131 'markdown-heading nil 1132 'markdown-heading-1-setext nil 1133 'markdown-heading-2-setext nil 1134 'markdown-heading-1-atx nil 1135 'markdown-heading-2-atx nil 1136 'markdown-heading-3-atx nil 1137 'markdown-heading-4-atx nil 1138 'markdown-heading-5-atx nil 1139 'markdown-heading-6-atx nil 1140 'markdown-metadata-key nil 1141 'markdown-metadata-value nil 1142 'markdown-metadata-markup nil) 1143 "Property list of all Markdown syntactic properties.") 1144 1145 (defvar markdown-literal-faces 1146 '(markdown-code-face 1147 markdown-inline-code-face 1148 markdown-pre-face 1149 markdown-math-face 1150 markdown-url-face 1151 markdown-plain-url-face 1152 markdown-language-keyword-face 1153 markdown-language-info-face 1154 markdown-metadata-key-face 1155 markdown-metadata-value-face 1156 markdown-html-entity-face 1157 markdown-html-tag-name-face 1158 markdown-html-tag-delimiter-face 1159 markdown-html-attr-name-face 1160 markdown-html-attr-value-face 1161 markdown-reference-face 1162 markdown-footnote-marker-face 1163 markdown-line-break-face 1164 markdown-comment-face) 1165 "A list of markdown-mode faces that contain literal text. 1166 Literal text treats backslashes literally, rather than as an 1167 escape character (see `markdown-match-escape').") 1168 1169 (defsubst markdown-in-comment-p (&optional pos) 1170 "Return non-nil if POS is in a comment. 1171 If POS is not given, use point instead." 1172 (get-text-property (or pos (point)) 'markdown-comment)) 1173 1174 (defun markdown--face-p (pos faces) 1175 "Return non-nil if face of POS contain FACES." 1176 (let ((face-prop (get-text-property pos 'face))) 1177 (if (listp face-prop) 1178 (cl-loop for face in face-prop 1179 thereis (memq face faces)) 1180 (memq face-prop faces)))) 1181 1182 (defsubst markdown--math-block-p (&optional pos) 1183 (when markdown-enable-math 1184 (markdown--face-p (or pos (point)) '(markdown-math-face)))) 1185 1186 (defun markdown-syntax-propertize-extend-region (start end) 1187 "Extend START to END region to include an entire block of text. 1188 This helps improve syntax analysis for block constructs. 1189 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. 1190 Function is called repeatedly until it returns nil. For details, see 1191 `syntax-propertize-extend-region-functions'." 1192 (save-match-data 1193 (save-excursion 1194 (let* ((new-start (progn (goto-char start) 1195 (skip-chars-forward "\n") 1196 (if (re-search-backward "\n\n" nil t) 1197 (min start (match-end 0)) 1198 (point-min)))) 1199 (new-end (progn (goto-char end) 1200 (skip-chars-backward "\n") 1201 (if (re-search-forward "\n\n" nil t) 1202 (max end (match-beginning 0)) 1203 (point-max)))) 1204 (code-match (markdown-code-block-at-pos new-start)) 1205 ;; FIXME: The `code-match' can return bogus values 1206 ;; when text has been inserted/deleted! 1207 (new-start (min (or (and code-match (cl-first code-match)) 1208 (point-max)) 1209 new-start)) 1210 (code-match (and (< end (point-max)) 1211 (markdown-code-block-at-pos end))) 1212 (new-end (max (or (and code-match (cl-second code-match)) 0) 1213 new-end))) 1214 1215 (unless (and (eq new-start start) (eq new-end end)) 1216 (cons new-start (min new-end (point-max)))))))) 1217 1218 (defun markdown-font-lock-extend-region-function (start end _) 1219 "Used in `jit-lock-after-change-extend-region-functions'. 1220 Delegates to `markdown-syntax-propertize-extend-region'. START 1221 and END are the previous region to refontify." 1222 (let ((res (markdown-syntax-propertize-extend-region start end))) 1223 (when res 1224 ;; syntax-propertize-function is not called when character at 1225 ;; (point-max) is deleted, but font-lock-extend-region-functions 1226 ;; are called. Force a syntax property update in that case. 1227 (when (= end (point-max)) 1228 ;; This function is called in a buffer modification hook. 1229 ;; `markdown-syntax-propertize' doesn't save the match data, 1230 ;; so we have to do it here. 1231 (save-match-data 1232 (markdown-syntax-propertize (car res) (cdr res)))) 1233 (setq jit-lock-start (car res) 1234 jit-lock-end (cdr res))))) 1235 1236 (defun markdown--cur-list-item-bounds () 1237 "Return a list describing the list item at point. 1238 Assumes that match data is set for `markdown-regex-list'. See the 1239 documentation for `markdown-cur-list-item-bounds' for the format of 1240 the returned list." 1241 (save-excursion 1242 (let* ((begin (match-beginning 0)) 1243 (indent (length (match-string-no-properties 1))) 1244 (nonlist-indent (- (match-end 3) (match-beginning 0))) 1245 (marker (buffer-substring-no-properties 1246 (match-beginning 2) (match-end 3))) 1247 (checkbox (match-string-no-properties 4)) 1248 (match (butlast (match-data t))) 1249 (end (markdown-cur-list-item-end nonlist-indent))) 1250 (list begin end indent nonlist-indent marker checkbox match)))) 1251 1252 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) 1253 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. 1254 Here, MARKER is a string representing the type of list and INDENT 1255 is an integer giving the indentation, in spaces, of the current 1256 block. CUR-BOUNDS is a list of the form returned by 1257 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds 1258 values for parent list items. When BOUNDS is nil, it means we are 1259 at baseline (not inside of a nested list)." 1260 (let ((prev-indent (or (cl-third (car bounds)) 0))) 1261 (cond 1262 ;; New list item at baseline. 1263 ((and marker (null bounds)) 1264 (list cur-bounds)) 1265 ;; List item with greater indentation (four or more spaces). 1266 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. 1267 ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) 1268 (cons cur-bounds bounds)) 1269 ;; List item with greater or equal indentation (less than four spaces). 1270 ;; Keep list level the same by replacing the car of BOUNDS. 1271 ((and marker (>= indent prev-indent)) 1272 (cons cur-bounds (cdr bounds))) 1273 ;; Lesser indentation level. 1274 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser 1275 ;; indentation could move back more than one list level). Note 1276 ;; that this block need not be the beginning of list item. 1277 ((< indent prev-indent) 1278 (while (and (> (length bounds) 1) 1279 (setq prev-indent (cl-third (cadr bounds))) 1280 (< indent (+ prev-indent markdown-list-indent-width))) 1281 (setq bounds (cdr bounds))) 1282 (cons cur-bounds bounds)) 1283 ;; Otherwise, do nothing. 1284 (t bounds)))) 1285 1286 (defun markdown-syntax-propertize-list-items (start end) 1287 "Propertize list items from START to END. 1288 Stores nested list item information in the `markdown-list-item' 1289 text property to make later syntax analysis easier. The value of 1290 this property is a list with elements of the form (begin . end) 1291 giving the bounds of the current and parent list items." 1292 (save-excursion 1293 (goto-char start) 1294 (let ((prev-list-line -100) 1295 bounds level pre-regexp) 1296 ;; Find a baseline point with zero list indentation 1297 (markdown-search-backward-baseline) 1298 ;; Search for all list items between baseline and END 1299 (while (and (< (point) end) 1300 (re-search-forward markdown-regex-list end 'limit)) 1301 ;; Level of list nesting 1302 (setq level (length bounds)) 1303 ;; Pre blocks need to be indented one level past the list level 1304 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) 1305 (beginning-of-line) 1306 (cond 1307 ;; Reset at headings, horizontal rules, and top-level blank lines. 1308 ;; Propertize baseline when in range. 1309 ((markdown-new-baseline) 1310 (setq bounds nil)) 1311 ;; Make sure this is not a line from a pre block 1312 ((and (looking-at-p pre-regexp) 1313 ;; too indented line is also treated as list if previous line is list 1314 (>= (- (line-number-at-pos) prev-list-line) 2))) 1315 ;; If not, then update levels and propertize list item when in range. 1316 (t 1317 (let* ((indent (current-indentation)) 1318 (cur-bounds (markdown--cur-list-item-bounds)) 1319 (first (cl-first cur-bounds)) 1320 (last (cl-second cur-bounds)) 1321 (marker (cl-fifth cur-bounds))) 1322 (setq bounds (markdown--append-list-item-bounds 1323 marker indent cur-bounds bounds)) 1324 (when (and (<= start (point)) (<= (point) end)) 1325 (setq prev-list-line (line-number-at-pos first)) 1326 (put-text-property first last 'markdown-list-item bounds))))) 1327 (end-of-line))))) 1328 1329 (defun markdown-syntax-propertize-pre-blocks (start end) 1330 "Match preformatted text blocks from START to END." 1331 (save-excursion 1332 (goto-char start) 1333 (let (finish) 1334 ;; Use loop for avoiding too many recursive calls 1335 ;; https://github.com/jrblevin/markdown-mode/issues/512 1336 (while (not finish) 1337 (let ((levels (markdown-calculate-list-levels)) 1338 indent pre-regexp close-regexp open close) 1339 (while (and (< (point) end) (not close)) 1340 ;; Search for a region with sufficient indentation 1341 (if (null levels) 1342 (setq indent 1) 1343 (setq indent (1+ (length levels)))) 1344 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) 1345 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) 1346 1347 (cond 1348 ;; If not at the beginning of a line, move forward 1349 ((not (bolp)) (forward-line)) 1350 ;; Move past blank lines 1351 ((markdown-cur-line-blank-p) (forward-line)) 1352 ;; At headers and horizontal rules, reset levels 1353 ((markdown-new-baseline) (forward-line) (setq levels nil)) 1354 ;; If the current line has sufficient indentation, mark out pre block 1355 ;; The opening should be preceded by a blank line. 1356 ((and (markdown-prev-line-blank) (looking-at pre-regexp)) 1357 (setq open (match-beginning 0)) 1358 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) 1359 (not (eobp))) 1360 (forward-line)) 1361 (skip-syntax-backward "-") 1362 (forward-line) 1363 (setq close (point))) 1364 ;; If current line has a list marker, update levels, move to end of block 1365 ((looking-at markdown-regex-list) 1366 (setq levels (markdown-update-list-levels 1367 (match-string 2) (current-indentation) levels)) 1368 (markdown-end-of-text-block)) 1369 ;; If this is the end of the indentation level, adjust levels accordingly. 1370 ;; Only match end of indentation level if levels is not the empty list. 1371 ((and (car levels) (looking-at-p close-regexp)) 1372 (setq levels (markdown-update-list-levels 1373 nil (current-indentation) levels)) 1374 (markdown-end-of-text-block)) 1375 (t (markdown-end-of-text-block)))) 1376 1377 (if (and open close) 1378 ;; Set text property data and continue to search 1379 (put-text-property open close 'markdown-pre (list open close)) 1380 (setq finish t)))) 1381 nil))) 1382 1383 (defconst markdown-fenced-block-pairs 1384 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) 1385 (markdown-make-tilde-fence-regex markdown-tilde-fence-end) 1386 markdown-fenced-code) 1387 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) 1388 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) 1389 markdown-yaml-metadata-section) 1390 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) 1391 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) 1392 markdown-gfm-code)) 1393 "Mapping of regular expressions to \"fenced-block\" constructs. 1394 These constructs are distinguished by having a distinctive start 1395 and end pattern, both of which take up an entire line of text, 1396 but no special pattern to identify text within the fenced 1397 blocks (unlike blockquotes and indented-code sections). 1398 1399 Each element within this list takes the form: 1400 1401 ((START-REGEX-OR-FUN START-PROPERTY) 1402 (END-REGEX-OR-FUN END-PROPERTY) 1403 MIDDLE-PROPERTY) 1404 1405 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a 1406 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no 1407 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument 1408 which is the length of the first group of the START-REGEX-OR-FUN match, which 1409 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to 1410 evaluate these into \"real\" regexps. 1411 1412 The *-PROPERTY elements are the text properties applied to each part of the 1413 block construct when it is matched using 1414 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied 1415 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and 1416 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the 1417 `match-data' when the regexp was matched to the text. In the case of 1418 MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with 1419 begin and end set to the edges of the \"middle\" text. This makes fontification 1420 easier.") 1421 1422 (defun markdown-text-property-at-point (prop) 1423 (get-text-property (point) prop)) 1424 1425 (defsubst markdown-maybe-funcall-regexp (object &optional arg) 1426 (cond ((functionp object) 1427 (if arg (funcall object arg) (funcall object))) 1428 ((stringp object) object) 1429 (t (error "Object cannot be turned into regex")))) 1430 1431 (defsubst markdown-get-start-fence-regexp () 1432 "Return regexp to find all \"start\" sections of fenced block constructs. 1433 Which construct is actually contained in the match must be found separately." 1434 (mapconcat 1435 #'identity 1436 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) 1437 markdown-fenced-block-pairs) 1438 "\\|")) 1439 1440 (defun markdown-get-fenced-block-begin-properties () 1441 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) 1442 1443 (defun markdown-get-fenced-block-end-properties () 1444 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) 1445 1446 (defun markdown-get-fenced-block-middle-properties () 1447 (cl-mapcar #'cl-third markdown-fenced-block-pairs)) 1448 1449 (defun markdown-find-previous-prop (prop &optional lim) 1450 "Find previous place where property PROP is non-nil, up to LIM. 1451 Return a cons of (pos . property). pos is point if point contains 1452 non-nil PROP." 1453 (let ((res 1454 (if (get-text-property (point) prop) (point) 1455 (previous-single-property-change 1456 (point) prop nil (or lim (point-min)))))) 1457 (when (and (not (get-text-property res prop)) 1458 (> res (point-min)) 1459 (get-text-property (1- res) prop)) 1460 (cl-decf res)) 1461 (when (and res (get-text-property res prop)) (cons res prop)))) 1462 1463 (defun markdown-find-next-prop (prop &optional lim) 1464 "Find next place where property PROP is non-nil, up to LIM. 1465 Return a cons of (POS . PROPERTY) where POS is point if point 1466 contains non-nil PROP." 1467 (let ((res 1468 (if (get-text-property (point) prop) (point) 1469 (next-single-property-change 1470 (point) prop nil (or lim (point-max)))))) 1471 (when (and res (get-text-property res prop)) (cons res prop)))) 1472 1473 (defun markdown-min-of-seq (map-fn seq) 1474 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." 1475 (cl-loop for el in seq 1476 with min = 1.0e+INF ; infinity 1477 with min-el = nil 1478 do (let ((res (funcall map-fn el))) 1479 (when (< res min) 1480 (setq min res) 1481 (setq min-el el))) 1482 finally return min-el)) 1483 1484 (defun markdown-max-of-seq (map-fn seq) 1485 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." 1486 (cl-loop for el in seq 1487 with max = -1.0e+INF ; negative infinity 1488 with max-el = nil 1489 do (let ((res (funcall map-fn el))) 1490 (when (and res (> res max)) 1491 (setq max res) 1492 (setq max-el el))) 1493 finally return max-el)) 1494 1495 (defun markdown-find-previous-block () 1496 "Find previous block. 1497 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was 1498 unable to propertize the entire block, but was able to propertize the beginning 1499 of the block. If so, return a cons of (pos . property) where the beginning of 1500 the block was propertized." 1501 (let ((start-pt (point)) 1502 (closest-open 1503 (markdown-max-of-seq 1504 #'car 1505 (cl-remove-if 1506 #'null 1507 (cl-mapcar 1508 #'markdown-find-previous-prop 1509 (markdown-get-fenced-block-begin-properties)))))) 1510 (when closest-open 1511 (let* ((length-of-open-match 1512 (let ((match-d 1513 (get-text-property (car closest-open) (cdr closest-open)))) 1514 (- (cl-fourth match-d) (cl-third match-d)))) 1515 (end-regexp 1516 (markdown-maybe-funcall-regexp 1517 (cl-caadr 1518 (cl-find-if 1519 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) 1520 markdown-fenced-block-pairs)) 1521 length-of-open-match)) 1522 (end-prop-loc 1523 (save-excursion 1524 (save-match-data 1525 (goto-char (car closest-open)) 1526 (and (re-search-forward end-regexp start-pt t) 1527 (match-beginning 0)))))) 1528 (and (not end-prop-loc) closest-open))))) 1529 1530 (defun markdown-get-fenced-block-from-start (prop) 1531 "Return limits of an enclosing fenced block from its start, using PROP. 1532 Return value is a list usable as `match-data'." 1533 (catch 'no-rest-of-block 1534 (let* ((correct-entry 1535 (cl-find-if 1536 (lambda (entry) (eq (cl-cadar entry) prop)) 1537 markdown-fenced-block-pairs)) 1538 (begin-of-begin (cl-first (markdown-text-property-at-point prop))) 1539 (middle-prop (cl-third correct-entry)) 1540 (end-prop (cl-cadadr correct-entry)) 1541 (end-of-end 1542 (save-excursion 1543 (goto-char (match-end 0)) ; end of begin 1544 (unless (eobp) (forward-char)) 1545 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1546 (if (not mid-prop-v) ; no middle 1547 (progn 1548 ;; try to find end by advancing one 1549 (let ((end-prop-v 1550 (markdown-text-property-at-point end-prop))) 1551 (if end-prop-v (cl-second end-prop-v) 1552 (throw 'no-rest-of-block nil)))) 1553 (set-match-data mid-prop-v) 1554 (goto-char (match-end 0)) ; end of middle 1555 (beginning-of-line) ; into end 1556 (cl-second (markdown-text-property-at-point end-prop))))))) 1557 (list begin-of-begin end-of-end)))) 1558 1559 (defun markdown-get-fenced-block-from-middle (prop) 1560 "Return limits of an enclosing fenced block from its middle, using PROP. 1561 Return value is a list usable as `match-data'." 1562 (let* ((correct-entry 1563 (cl-find-if 1564 (lambda (entry) (eq (cl-third entry) prop)) 1565 markdown-fenced-block-pairs)) 1566 (begin-prop (cl-cadar correct-entry)) 1567 (begin-of-begin 1568 (save-excursion 1569 (goto-char (match-beginning 0)) 1570 (unless (bobp) (forward-line -1)) 1571 (beginning-of-line) 1572 (cl-first (markdown-text-property-at-point begin-prop)))) 1573 (end-prop (cl-cadadr correct-entry)) 1574 (end-of-end 1575 (save-excursion 1576 (goto-char (match-end 0)) 1577 (beginning-of-line) 1578 (cl-second (markdown-text-property-at-point end-prop))))) 1579 (list begin-of-begin end-of-end))) 1580 1581 (defun markdown-get-fenced-block-from-end (prop) 1582 "Return limits of an enclosing fenced block from its end, using PROP. 1583 Return value is a list usable as `match-data'." 1584 (let* ((correct-entry 1585 (cl-find-if 1586 (lambda (entry) (eq (cl-cadadr entry) prop)) 1587 markdown-fenced-block-pairs)) 1588 (end-of-end (cl-second (markdown-text-property-at-point prop))) 1589 (middle-prop (cl-third correct-entry)) 1590 (begin-prop (cl-cadar correct-entry)) 1591 (begin-of-begin 1592 (save-excursion 1593 (goto-char (match-beginning 0)) ; beginning of end 1594 (unless (bobp) (backward-char)) ; into middle 1595 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1596 (if (not mid-prop-v) 1597 (progn 1598 (beginning-of-line) 1599 (cl-first (markdown-text-property-at-point begin-prop))) 1600 (set-match-data mid-prop-v) 1601 (goto-char (match-beginning 0)) ; beginning of middle 1602 (unless (bobp) (forward-line -1)) ; into beginning 1603 (beginning-of-line) 1604 (cl-first (markdown-text-property-at-point begin-prop))))))) 1605 (list begin-of-begin end-of-end))) 1606 1607 (defun markdown-get-enclosing-fenced-block-construct (&optional pos) 1608 "Get \"fake\" match data for block enclosing POS. 1609 Returns fake match data which encloses the start, middle, and end 1610 of the block construct enclosing POS, if it exists. Used in 1611 `markdown-code-block-at-pos'." 1612 (save-excursion 1613 (when pos (goto-char pos)) 1614 (beginning-of-line) 1615 (car 1616 (cl-remove-if 1617 #'null 1618 (cl-mapcar 1619 (lambda (fun-and-prop) 1620 (cl-destructuring-bind (fun prop) fun-and-prop 1621 (when prop 1622 (save-match-data 1623 (set-match-data (markdown-text-property-at-point prop)) 1624 (funcall fun prop))))) 1625 `((markdown-get-fenced-block-from-start 1626 ,(cl-find-if 1627 #'markdown-text-property-at-point 1628 (markdown-get-fenced-block-begin-properties))) 1629 (markdown-get-fenced-block-from-middle 1630 ,(cl-find-if 1631 #'markdown-text-property-at-point 1632 (markdown-get-fenced-block-middle-properties))) 1633 (markdown-get-fenced-block-from-end 1634 ,(cl-find-if 1635 #'markdown-text-property-at-point 1636 (markdown-get-fenced-block-end-properties))))))))) 1637 1638 (defun markdown-propertize-end-match (reg end fence-spec middle-begin) 1639 "Get match for REG up to END, if exists, and propertize appropriately. 1640 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and 1641 MIDDLE-BEGIN is the start of the \"middle\" section of the block." 1642 (when (re-search-forward reg end t) 1643 (let ((close-begin (match-beginning 0)) ; Start of closing line. 1644 (close-end (match-end 0)) ; End of closing line. 1645 (close-data (match-data t))) ; Match data for closing line. 1646 ;; Propertize middle section of fenced block. 1647 (put-text-property middle-begin close-begin 1648 (cl-third fence-spec) 1649 (list middle-begin close-begin)) 1650 ;; If the block is a YAML block, propertize the declarations inside 1651 (when (< middle-begin close-begin) ;; workaround #634 1652 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) 1653 ;; Propertize closing line of fenced block. 1654 (put-text-property close-begin close-end 1655 (cl-cadadr fence-spec) close-data)))) 1656 1657 (defun markdown--triple-quote-single-line-p (begin) 1658 (save-excursion 1659 (goto-char begin) 1660 (save-match-data 1661 (and (search-forward "```" nil t) 1662 (search-forward "```" (line-end-position) t))))) 1663 1664 (defun markdown-syntax-propertize-fenced-block-constructs (start end) 1665 "Propertize according to `markdown-fenced-block-pairs' from START to END. 1666 If unable to propertize an entire block (if the start of a block is within START 1667 and END, but the end of the block is not), propertize the start section of a 1668 block, then in a subsequent call propertize both middle and end by finding the 1669 start which was previously propertized." 1670 (let ((start-reg (markdown-get-start-fence-regexp))) 1671 (save-excursion 1672 (goto-char start) 1673 ;; start from previous unclosed block, if exists 1674 (let ((prev-begin-block (markdown-find-previous-block))) 1675 (when prev-begin-block 1676 (let* ((correct-entry 1677 (cl-find-if (lambda (entry) 1678 (eq (cdr prev-begin-block) (cl-cadar entry))) 1679 markdown-fenced-block-pairs)) 1680 (enclosed-text-start (1+ (car prev-begin-block))) 1681 (start-length 1682 (save-excursion 1683 (goto-char (car prev-begin-block)) 1684 (string-match 1685 (markdown-maybe-funcall-regexp 1686 (caar correct-entry)) 1687 (buffer-substring 1688 (line-beginning-position) (line-end-position))) 1689 (- (match-end 1) (match-beginning 1)))) 1690 (end-reg (markdown-maybe-funcall-regexp 1691 (cl-caadr correct-entry) start-length))) 1692 (markdown-propertize-end-match 1693 end-reg end correct-entry enclosed-text-start)))) 1694 ;; find all new blocks within region 1695 (while (re-search-forward start-reg end t) 1696 ;; we assume the opening constructs take up (only) an entire line, 1697 ;; so we re-check the current line 1698 (let* ((block-start (match-beginning 0)) 1699 (cur-line (buffer-substring (line-beginning-position) (line-end-position))) 1700 ;; find entry in `markdown-fenced-block-pairs' corresponding 1701 ;; to regex which was matched 1702 (correct-entry 1703 (cl-find-if 1704 (lambda (fenced-pair) 1705 (string-match-p 1706 (markdown-maybe-funcall-regexp (caar fenced-pair)) 1707 cur-line)) 1708 markdown-fenced-block-pairs)) 1709 (enclosed-text-start 1710 (save-excursion (1+ (line-end-position)))) 1711 (end-reg 1712 (markdown-maybe-funcall-regexp 1713 (cl-caadr correct-entry) 1714 (if (and (match-beginning 1) (match-end 1)) 1715 (- (match-end 1) (match-beginning 1)) 1716 0))) 1717 (prop (cl-cadar correct-entry))) 1718 (when (or (not (eq prop 'markdown-gfm-block-begin)) 1719 (not (markdown--triple-quote-single-line-p block-start))) 1720 ;; get correct match data 1721 (save-excursion 1722 (beginning-of-line) 1723 (re-search-forward 1724 (markdown-maybe-funcall-regexp (caar correct-entry)) 1725 (line-end-position))) 1726 ;; mark starting, even if ending is outside of region 1727 (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) 1728 (markdown-propertize-end-match 1729 end-reg end correct-entry enclosed-text-start))))))) 1730 1731 (defun markdown-syntax-propertize-blockquotes (start end) 1732 "Match blockquotes from START to END." 1733 (save-excursion 1734 (goto-char start) 1735 (while (and (re-search-forward markdown-regex-blockquote end t) 1736 (not (markdown-code-block-at-pos (match-beginning 0)))) 1737 (put-text-property (match-beginning 0) (match-end 0) 1738 'markdown-blockquote 1739 (match-data t))))) 1740 1741 (defun markdown-syntax-propertize-hrs (start end) 1742 "Match horizontal rules from START to END." 1743 (save-excursion 1744 (goto-char start) 1745 (while (re-search-forward markdown-regex-hr end t) 1746 (let ((beg (match-beginning 0)) 1747 (end (match-end 0))) 1748 (goto-char beg) 1749 (unless (or (markdown-on-heading-p) 1750 (markdown-code-block-at-point-p)) 1751 (put-text-property beg end 'markdown-hr (match-data t))) 1752 (goto-char end))))) 1753 1754 (defun markdown-syntax-propertize-yaml-metadata (start end) 1755 "Propertize elements inside YAML metadata blocks from START to END. 1756 Assumes region from START and END is already known to be the interior 1757 region of a YAML metadata block as propertized by 1758 `markdown-syntax-propertize-fenced-block-constructs'." 1759 (save-excursion 1760 (goto-char start) 1761 (cl-loop 1762 while (re-search-forward markdown-regex-declarative-metadata end t) 1763 do (progn 1764 (put-text-property (match-beginning 1) (match-end 1) 1765 'markdown-metadata-key (match-data t)) 1766 (put-text-property (match-beginning 2) (match-end 2) 1767 'markdown-metadata-markup (match-data t)) 1768 (put-text-property (match-beginning 3) (match-end 3) 1769 'markdown-metadata-value (match-data t)))))) 1770 1771 (defun markdown-syntax-propertize-headings (start end) 1772 "Match headings of type SYMBOL with REGEX from START to END." 1773 (goto-char start) 1774 (while (re-search-forward markdown-regex-header end t) 1775 (unless (markdown-code-block-at-pos (match-beginning 0)) 1776 (put-text-property 1777 (match-beginning 0) (match-end 0) 'markdown-heading 1778 (match-data t)) 1779 (put-text-property 1780 (match-beginning 0) (match-end 0) 1781 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) 1782 ((match-string-no-properties 3) 'markdown-heading-2-setext) 1783 (t (let ((atx-level (length (markdown-trim-whitespace 1784 (match-string-no-properties 4))))) 1785 (intern (format "markdown-heading-%d-atx" atx-level))))) 1786 (match-data t))))) 1787 1788 (defun markdown-syntax-propertize-comments (start end) 1789 "Match HTML comments from the START to END." 1790 ;; Implement by loop instead of recursive call for avoiding 1791 ;; exceed max-lisp-eval-depth issue 1792 ;; https://github.com/jrblevin/markdown-mode/issues/536 1793 (let (finish) 1794 (goto-char start) 1795 (while (not finish) 1796 (let* ((in-comment (nth 4 (syntax-ppss))) 1797 (comment-begin (nth 8 (syntax-ppss)))) 1798 (cond 1799 ;; Comment start 1800 ((and (not in-comment) 1801 (re-search-forward markdown-regex-comment-start end t) 1802 (not (markdown-inline-code-at-point-p)) 1803 (not (markdown-code-block-at-point-p))) 1804 (let ((open-beg (match-beginning 0))) 1805 (put-text-property open-beg (1+ open-beg) 1806 'syntax-table (string-to-syntax "<")) 1807 (goto-char (min (1+ (match-end 0)) end (point-max))))) 1808 ;; Comment end 1809 ((and in-comment comment-begin 1810 (re-search-forward markdown-regex-comment-end end t)) 1811 (let ((comment-end (match-end 0))) 1812 (put-text-property (1- comment-end) comment-end 1813 'syntax-table (string-to-syntax ">")) 1814 ;; Remove any other text properties inside the comment 1815 (remove-text-properties comment-begin comment-end 1816 markdown--syntax-properties) 1817 (put-text-property comment-begin comment-end 1818 'markdown-comment (list comment-begin comment-end)) 1819 (goto-char (min comment-end end (point-max))))) 1820 ;; Nothing found 1821 (t (setq finish t))))) 1822 nil)) 1823 1824 (defun markdown-syntax-propertize (start end) 1825 "Function used as `syntax-propertize-function'. 1826 START and END delimit region to propertize." 1827 (with-silent-modifications 1828 (save-excursion 1829 (remove-text-properties start end markdown--syntax-properties) 1830 (markdown-syntax-propertize-fenced-block-constructs start end) 1831 (markdown-syntax-propertize-list-items start end) 1832 (markdown-syntax-propertize-pre-blocks start end) 1833 (markdown-syntax-propertize-blockquotes start end) 1834 (markdown-syntax-propertize-headings start end) 1835 (markdown-syntax-propertize-hrs start end) 1836 (markdown-syntax-propertize-comments start end)))) 1837 1838 1839 ;;; Markup Hiding ============================================================= 1840 1841 (defconst markdown-markup-properties 1842 '(face markdown-markup-face invisible markdown-markup) 1843 "List of properties and values to apply to markup.") 1844 1845 (defconst markdown-line-break-properties 1846 '(face markdown-line-break-face invisible markdown-markup) 1847 "List of properties and values to apply to line break markup.") 1848 1849 (defconst markdown-language-keyword-properties 1850 '(face markdown-language-keyword-face invisible markdown-markup) 1851 "List of properties and values to apply to code block language names.") 1852 1853 (defconst markdown-language-info-properties 1854 '(face markdown-language-info-face invisible markdown-markup) 1855 "List of properties and values to apply to code block language info strings.") 1856 1857 (defconst markdown-include-title-properties 1858 '(face markdown-link-title-face invisible markdown-markup) 1859 "List of properties and values to apply to included code titles.") 1860 1861 (defcustom markdown-hide-markup nil 1862 "Determines whether markup in the buffer will be hidden. 1863 When set to nil, all markup is displayed in the buffer as it 1864 appears in the file. An exception is when `markdown-hide-urls' 1865 is non-nil. 1866 Set this to a non-nil value to turn this feature on by default. 1867 You can interactively toggle the value of this variable with 1868 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], 1869 or from the Markdown > Show & Hide menu. 1870 1871 Markup hiding works by adding text properties to positions in the 1872 buffer---either the `invisible' property or the `display' property 1873 in cases where alternative glyphs are used (e.g., list bullets). 1874 This does not, however, affect printing or other output. 1875 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will 1876 not honor these text properties. For printing, it would be better 1877 to first convert to HTML or PDF (e.g,. using Pandoc)." 1878 :group 'markdown 1879 :type 'boolean 1880 :safe 'booleanp 1881 :package-version '(markdown-mode . "2.3")) 1882 (make-variable-buffer-local 'markdown-hide-markup) 1883 1884 (defun markdown-toggle-markup-hiding (&optional arg) 1885 "Toggle the display or hiding of markup. 1886 With a prefix argument ARG, enable markup hiding if ARG is positive, 1887 and disable it otherwise. 1888 See `markdown-hide-markup' for additional details." 1889 (interactive (list (or current-prefix-arg 'toggle))) 1890 (setq markdown-hide-markup 1891 (if (eq arg 'toggle) 1892 (not markdown-hide-markup) 1893 (> (prefix-numeric-value arg) 0))) 1894 (if markdown-hide-markup 1895 (add-to-invisibility-spec 'markdown-markup) 1896 (remove-from-invisibility-spec 'markdown-markup)) 1897 (when (called-interactively-p 'interactive) 1898 (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) 1899 (markdown-reload-extensions)) 1900 1901 1902 ;;; Font Lock ================================================================= 1903 1904 (require 'font-lock) 1905 1906 (defgroup markdown-faces nil 1907 "Faces used in Markdown Mode." 1908 :group 'markdown 1909 :group 'faces) 1910 1911 (defface markdown-italic-face 1912 '((t (:inherit italic))) 1913 "Face for italic text." 1914 :group 'markdown-faces) 1915 1916 (defface markdown-bold-face 1917 '((t (:inherit bold))) 1918 "Face for bold text." 1919 :group 'markdown-faces) 1920 1921 (defface markdown-strike-through-face 1922 '((t (:strike-through t))) 1923 "Face for strike-through text." 1924 :group 'markdown-faces) 1925 1926 (defface markdown-markup-face 1927 '((t (:inherit shadow :slant normal :weight normal))) 1928 "Face for markup elements." 1929 :group 'markdown-faces) 1930 1931 (defface markdown-header-rule-face 1932 '((t (:inherit markdown-markup-face))) 1933 "Base face for headers rules." 1934 :group 'markdown-faces) 1935 1936 (defface markdown-header-delimiter-face 1937 '((t (:inherit markdown-markup-face))) 1938 "Base face for headers hash delimiter." 1939 :group 'markdown-faces) 1940 1941 (defface markdown-list-face 1942 '((t (:inherit markdown-markup-face))) 1943 "Face for list item markers." 1944 :group 'markdown-faces) 1945 1946 (defface markdown-blockquote-face 1947 '((t (:inherit font-lock-doc-face))) 1948 "Face for blockquote sections." 1949 :group 'markdown-faces) 1950 1951 (defface markdown-code-face 1952 '((t (:inherit fixed-pitch))) 1953 "Face for inline code, pre blocks, and fenced code blocks. 1954 This may be used, for example, to add a contrasting background to 1955 inline code fragments and code blocks." 1956 :group 'markdown-faces) 1957 1958 (defface markdown-inline-code-face 1959 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1960 "Face for inline code." 1961 :group 'markdown-faces) 1962 1963 (defface markdown-pre-face 1964 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1965 "Face for preformatted text." 1966 :group 'markdown-faces) 1967 1968 (defface markdown-table-face 1969 '((t (:inherit (markdown-code-face)))) 1970 "Face for tables." 1971 :group 'markdown-faces) 1972 1973 (defface markdown-language-keyword-face 1974 '((t (:inherit font-lock-type-face))) 1975 "Face for programming language identifiers." 1976 :group 'markdown-faces) 1977 1978 (defface markdown-language-info-face 1979 '((t (:inherit font-lock-string-face))) 1980 "Face for programming language info strings." 1981 :group 'markdown-faces) 1982 1983 (defface markdown-link-face 1984 '((t (:inherit link))) 1985 "Face for links." 1986 :group 'markdown-faces) 1987 1988 (defface markdown-missing-link-face 1989 '((t (:inherit font-lock-warning-face))) 1990 "Face for missing links." 1991 :group 'markdown-faces) 1992 1993 (defface markdown-reference-face 1994 '((t (:inherit markdown-markup-face))) 1995 "Face for link references." 1996 :group 'markdown-faces) 1997 1998 (defface markdown-footnote-marker-face 1999 '((t (:inherit markdown-markup-face))) 2000 "Face for footnote markers." 2001 :group 'markdown-faces) 2002 2003 (defface markdown-footnote-text-face 2004 '((t (:inherit font-lock-comment-face))) 2005 "Face for footnote text." 2006 :group 'markdown-faces) 2007 2008 (defface markdown-url-face 2009 '((t (:inherit font-lock-string-face))) 2010 "Face for URLs that are part of markup. 2011 For example, this applies to URLs in inline links: 2012 [link text](http://example.com/)." 2013 :group 'markdown-faces) 2014 2015 (defface markdown-plain-url-face 2016 '((t (:inherit markdown-link-face))) 2017 "Face for URLs that are also links. 2018 For example, this applies to plain angle bracket URLs: 2019 <http://example.com/>." 2020 :group 'markdown-faces) 2021 2022 (defface markdown-link-title-face 2023 '((t (:inherit font-lock-comment-face))) 2024 "Face for reference link titles." 2025 :group 'markdown-faces) 2026 2027 (defface markdown-line-break-face 2028 '((t (:inherit font-lock-constant-face :underline t))) 2029 "Face for hard line breaks." 2030 :group 'markdown-faces) 2031 2032 (defface markdown-comment-face 2033 '((t (:inherit font-lock-comment-face))) 2034 "Face for HTML comments." 2035 :group 'markdown-faces) 2036 2037 (defface markdown-math-face 2038 '((t (:inherit font-lock-string-face))) 2039 "Face for LaTeX expressions." 2040 :group 'markdown-faces) 2041 2042 (defface markdown-metadata-key-face 2043 '((t (:inherit font-lock-variable-name-face))) 2044 "Face for metadata keys." 2045 :group 'markdown-faces) 2046 2047 (defface markdown-metadata-value-face 2048 '((t (:inherit font-lock-string-face))) 2049 "Face for metadata values." 2050 :group 'markdown-faces) 2051 2052 (defface markdown-gfm-checkbox-face 2053 '((t (:inherit font-lock-builtin-face))) 2054 "Face for GFM checkboxes." 2055 :group 'markdown-faces) 2056 2057 (defface markdown-highlight-face 2058 '((t (:inherit highlight))) 2059 "Face for mouse highlighting." 2060 :group 'markdown-faces) 2061 2062 (defface markdown-hr-face 2063 '((t (:inherit markdown-markup-face))) 2064 "Face for horizontal rules." 2065 :group 'markdown-faces) 2066 2067 (defface markdown-html-tag-name-face 2068 '((t (:inherit font-lock-type-face))) 2069 "Face for HTML tag names." 2070 :group 'markdown-faces) 2071 2072 (defface markdown-html-tag-delimiter-face 2073 '((t (:inherit markdown-markup-face))) 2074 "Face for HTML tag delimiters." 2075 :group 'markdown-faces) 2076 2077 (defface markdown-html-attr-name-face 2078 '((t (:inherit font-lock-variable-name-face))) 2079 "Face for HTML attribute names." 2080 :group 'markdown-faces) 2081 2082 (defface markdown-html-attr-value-face 2083 '((t (:inherit font-lock-string-face))) 2084 "Face for HTML attribute values." 2085 :group 'markdown-faces) 2086 2087 (defface markdown-html-entity-face 2088 '((t (:inherit font-lock-variable-name-face))) 2089 "Face for HTML entities." 2090 :group 'markdown-faces) 2091 2092 (defface markdown-highlighting-face 2093 '((t (:background "yellow" :foreground "black"))) 2094 "Face for highlighting." 2095 :group 'markdown-faces) 2096 2097 (defcustom markdown-header-scaling nil 2098 "Whether to use variable-height faces for headers. 2099 When non-nil, `markdown-header-face' will inherit from 2100 `variable-pitch' and the scaling values in 2101 `markdown-header-scaling-values' will be applied to 2102 headers of levels one through six respectively." 2103 :type 'boolean 2104 :initialize #'custom-initialize-default 2105 :set (lambda (symbol value) 2106 (set-default symbol value) 2107 (markdown-update-header-faces value)) 2108 :group 'markdown-faces 2109 :package-version '(markdown-mode . "2.2")) 2110 2111 (defcustom markdown-header-scaling-values 2112 '(2.0 1.7 1.4 1.1 1.0 1.0) 2113 "List of scaling values for headers of level one through six. 2114 Used when `markdown-header-scaling' is non-nil." 2115 :type '(repeat float) 2116 :initialize #'custom-initialize-default 2117 :set (lambda (symbol value) 2118 (set-default symbol value) 2119 (markdown-update-header-faces markdown-header-scaling value))) 2120 2121 (defmacro markdown--dotimes-when-compile (i-n body) 2122 (declare (indent 1) (debug ((symbolp form) form))) 2123 (let ((var (car i-n)) 2124 (n (cadr i-n)) 2125 (code ())) 2126 (dotimes (i (eval n t)) 2127 (push (eval body `((,var . ,i))) code)) 2128 `(progn ,@(nreverse code)))) 2129 2130 (defface markdown-header-face 2131 `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) 2132 font-lock-function-name-face) 2133 :weight bold))) 2134 "Base face for headers.") 2135 2136 (markdown--dotimes-when-compile (num 6) 2137 (let* ((num1 (1+ num)) 2138 (face-name (intern (format "markdown-header-face-%s" num1)))) 2139 `(defface ,face-name 2140 (,'\` ((t (:inherit markdown-header-face 2141 :height 2142 (,'\, (if markdown-header-scaling 2143 (float (nth ,num markdown-header-scaling-values)) 2144 1.0)))))) 2145 (format "Face for level %s headers. 2146 You probably don't want to customize this face directly. Instead 2147 you can customize the base face `markdown-header-face' or the 2148 variable-height variable `markdown-header-scaling'." ,num1)))) 2149 2150 (defun markdown-update-header-faces (&optional scaling scaling-values) 2151 "Update header faces, depending on if header SCALING is desired. 2152 If so, use given list of SCALING-VALUES relative to the baseline 2153 size of `markdown-header-face'." 2154 (dotimes (num 6) 2155 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) 2156 (scale (cond ((not scaling) 1.0) 2157 (scaling-values (float (nth num scaling-values))) 2158 (t (float (nth num markdown-header-scaling-values)))))) 2159 (unless (get face-name 'saved-face) ; Don't update customized faces 2160 (set-face-attribute face-name nil :height scale))))) 2161 2162 (defun markdown-syntactic-face (state) 2163 "Return font-lock face for characters with given STATE. 2164 See `font-lock-syntactic-face-function' for details." 2165 (let ((in-comment (nth 4 state))) 2166 (cond 2167 (in-comment 'markdown-comment-face) 2168 (t nil)))) 2169 2170 (defcustom markdown-list-item-bullets 2171 '("●" "◎" "○" "◆" "◇" "►" "•") 2172 "List of bullets to use for unordered lists. 2173 It can contain any number of symbols, which will be repeated. 2174 Depending on your font, some reasonable choices are: 2175 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." 2176 :group 'markdown 2177 :type '(repeat (string :tag "Bullet character")) 2178 :package-version '(markdown-mode . "2.3")) 2179 2180 (defun markdown--footnote-marker-properties () 2181 "Return a font-lock facespec expression for footnote marker text." 2182 `(face markdown-footnote-marker-face 2183 ,@(when markdown-hide-markup 2184 `(display ,markdown-footnote-display)))) 2185 2186 (defun markdown--pandoc-inline-footnote-properties () 2187 "Return a font-lock facespec expression for Pandoc inline footnote text." 2188 `(face markdown-footnote-text-face 2189 ,@(when markdown-hide-markup 2190 `(display ,markdown-footnote-display)))) 2191 2192 (defvar markdown-mode-font-lock-keywords 2193 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) 2194 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) 2195 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) 2196 (2 'markdown-markup-face) 2197 (3 'markdown-metadata-value-face))) 2198 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) 2199 (2 markdown-markup-properties nil t) 2200 (3 markdown-language-keyword-properties nil t) 2201 (4 markdown-language-info-properties nil t) 2202 (5 markdown-markup-properties nil t))) 2203 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) 2204 (markdown-fontify-gfm-code-blocks) 2205 (markdown-fontify-tables) 2206 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) 2207 (2 markdown-markup-properties nil t) 2208 (3 markdown-language-keyword-properties nil t) 2209 (4 markdown-language-info-properties nil t) 2210 (5 markdown-markup-properties nil t))) 2211 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) 2212 (markdown-fontify-fenced-code-blocks) 2213 (markdown-match-pre-blocks . ((0 'markdown-pre-face))) 2214 (markdown-fontify-headings) 2215 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) 2216 (2 'markdown-markup-face) 2217 (3 'markdown-metadata-value-face))) 2218 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) 2219 (2 'markdown-markup-face) 2220 (3 'markdown-metadata-value-face))) 2221 (markdown-fontify-hrs) 2222 (markdown-match-code . ((1 markdown-markup-properties prepend) 2223 (2 'markdown-inline-code-face prepend) 2224 (3 markdown-markup-properties prepend))) 2225 (,markdown-regex-kbd . ((1 markdown-markup-properties) 2226 (2 'markdown-inline-code-face) 2227 (3 markdown-markup-properties))) 2228 (markdown-fontify-angle-uris) 2229 (,markdown-regex-email . 'markdown-plain-url-face) 2230 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) 2231 (2 'markdown-html-tag-name-face t) 2232 (3 'markdown-html-tag-delimiter-face t) 2233 ;; Anchored matcher for HTML tag attributes 2234 (,markdown-regex-html-attr 2235 ;; Before searching, move past tag 2236 ;; name; set limit at tag close. 2237 (progn 2238 (goto-char (match-end 2)) (match-end 3)) 2239 nil 2240 . ((1 'markdown-html-attr-name-face) 2241 (3 'markdown-html-tag-delimiter-face nil t) 2242 (4 'markdown-html-attr-value-face nil t))))) 2243 (,markdown-regex-html-entity . 'markdown-html-entity-face) 2244 (markdown-fontify-list-items) 2245 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ 2246 (2 (markdown--footnote-marker-properties)) ; label 2247 (3 markdown-markup-properties))) ; ] 2248 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ 2249 (2 markdown-markup-properties) ; [ 2250 (3 (markdown--pandoc-inline-footnote-properties)) ; text 2251 (4 markdown-markup-properties))) ; ] 2252 (markdown-match-includes . ((1 markdown-markup-properties) 2253 (2 markdown-markup-properties nil t) 2254 (3 markdown-include-title-properties nil t) 2255 (4 markdown-markup-properties nil t) 2256 (5 markdown-markup-properties) 2257 (6 'markdown-url-face) 2258 (7 markdown-markup-properties))) 2259 (markdown-fontify-inline-links) 2260 (markdown-fontify-reference-links) 2261 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ 2262 (2 'markdown-reference-face) ; label 2263 (3 'markdown-markup-face) ; ] 2264 (4 'markdown-markup-face) ; : 2265 (5 'markdown-url-face) ; url 2266 (6 'markdown-link-title-face))) ; "title" (optional) 2267 (markdown-fontify-plain-uris) 2268 ;; Math mode $..$ 2269 (markdown-match-math-single . ((1 'markdown-markup-face prepend) 2270 (2 'markdown-math-face append) 2271 (3 'markdown-markup-face prepend))) 2272 ;; Math mode $$..$$ 2273 (markdown-match-math-double . ((1 'markdown-markup-face prepend) 2274 (2 'markdown-math-face append) 2275 (3 'markdown-markup-face prepend))) 2276 ;; Math mode \[..\] and \\[..\\] 2277 (markdown-match-math-display . ((1 'markdown-markup-face prepend) 2278 (3 'markdown-math-face append) 2279 (4 'markdown-markup-face prepend))) 2280 (markdown-match-bold . ((1 markdown-markup-properties prepend) 2281 (2 'markdown-bold-face append) 2282 (3 markdown-markup-properties prepend))) 2283 (markdown-match-italic . ((1 markdown-markup-properties prepend) 2284 (2 'markdown-italic-face append) 2285 (3 markdown-markup-properties prepend))) 2286 (,markdown-regex-strike-through . ((3 markdown-markup-properties) 2287 (4 'markdown-strike-through-face) 2288 (5 markdown-markup-properties))) 2289 (markdown--match-highlighting . ((3 markdown-markup-properties) 2290 (4 'markdown-highlighting-face) 2291 (5 markdown-markup-properties))) 2292 (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) 2293 (markdown-match-escape . ((1 markdown-markup-properties prepend))) 2294 (markdown-fontify-sub-superscripts) 2295 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) 2296 (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) 2297 (markdown-fontify-blockquotes) 2298 (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) 2299 "Syntax highlighting for Markdown files.") 2300 2301 ;; Footnotes 2302 (defvar-local markdown-footnote-counter 0 2303 "Counter for footnote numbers.") 2304 2305 (defconst markdown-footnote-chars 2306 "[[:alnum:]-]" 2307 "Regular expression matching any character for a footnote identifier.") 2308 2309 (defconst markdown-regex-footnote-definition 2310 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") 2311 "Regular expression matching a footnote definition, capturing the label.") 2312 2313 2314 ;;; Compatibility ============================================================= 2315 2316 (defun markdown--pandoc-reference-p () 2317 (let ((bounds (bounds-of-thing-at-point 'word))) 2318 (when (and bounds (char-before (car bounds))) 2319 (= (char-before (car bounds)) ?@)))) 2320 2321 (defun markdown-flyspell-check-word-p () 2322 "Return t if `flyspell' should check word just before point. 2323 Used for `flyspell-generic-check-word-predicate'." 2324 (save-excursion 2325 (goto-char (1- (point))) 2326 ;; https://github.com/jrblevin/markdown-mode/issues/560 2327 ;; enable spell check YAML meta data 2328 (if (or (and (markdown-code-block-at-point-p) 2329 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) 2330 (markdown-inline-code-at-point-p) 2331 (markdown-in-comment-p) 2332 (markdown--face-p (point) '(markdown-reference-face 2333 markdown-markup-face 2334 markdown-plain-url-face 2335 markdown-inline-code-face 2336 markdown-url-face)) 2337 (markdown--pandoc-reference-p)) 2338 (prog1 nil 2339 ;; If flyspell overlay is put, then remove it 2340 (let ((bounds (bounds-of-thing-at-point 'word))) 2341 (when bounds 2342 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) 2343 when (overlay-get ov 'flyspell-overlay) 2344 do 2345 (delete-overlay ov))))) 2346 t))) 2347 2348 2349 ;;; Markdown Parsing Functions ================================================ 2350 2351 (defun markdown-cur-line-blank-p () 2352 "Return t if the current line is blank and nil otherwise." 2353 (save-excursion 2354 (beginning-of-line) 2355 (looking-at-p markdown-regex-blank-line))) 2356 2357 (defun markdown-prev-line-blank () 2358 "Return t if the previous line is blank and nil otherwise. 2359 If we are at the first line, then consider the previous line to be blank." 2360 (or (= (line-beginning-position) (point-min)) 2361 (save-excursion 2362 (forward-line -1) 2363 (looking-at markdown-regex-blank-line)))) 2364 2365 (defun markdown-prev-line-blank-p () 2366 "Like `markdown-prev-line-blank', but preserve `match-data'." 2367 (save-match-data (markdown-prev-line-blank))) 2368 2369 (defun markdown-next-line-blank-p () 2370 "Return t if the next line is blank and nil otherwise. 2371 If we are at the last line, then consider the next line to be blank." 2372 (or (= (line-end-position) (point-max)) 2373 (save-excursion 2374 (forward-line 1) 2375 (markdown-cur-line-blank-p)))) 2376 2377 (defun markdown-prev-line-indent () 2378 "Return the number of leading whitespace characters in the previous line. 2379 Return 0 if the current line is the first line in the buffer." 2380 (save-excursion 2381 (if (= (line-beginning-position) (point-min)) 2382 0 2383 (forward-line -1) 2384 (current-indentation)))) 2385 2386 (defun markdown-next-line-indent () 2387 "Return the number of leading whitespace characters in the next line. 2388 Return 0 if line is the last line in the buffer." 2389 (save-excursion 2390 (if (= (line-end-position) (point-max)) 2391 0 2392 (forward-line 1) 2393 (current-indentation)))) 2394 2395 (defun markdown-new-baseline () 2396 "Determine if the current line begins a new baseline level. 2397 Assume point is positioned at beginning of line." 2398 (or (looking-at markdown-regex-header) 2399 (looking-at markdown-regex-hr) 2400 (and (= (current-indentation) 0) 2401 (not (looking-at markdown-regex-list)) 2402 (markdown-prev-line-blank)))) 2403 2404 (defun markdown-search-backward-baseline () 2405 "Search backward baseline point with no indentation and not a list item." 2406 (end-of-line) 2407 (let (stop) 2408 (while (not (or stop (bobp))) 2409 (re-search-backward markdown-regex-block-separator-noindent nil t) 2410 (when (match-end 2) 2411 (goto-char (match-end 2)) 2412 (cond 2413 ((markdown-new-baseline) 2414 (setq stop t)) 2415 ((looking-at-p markdown-regex-list) 2416 (setq stop nil)) 2417 (t (setq stop t))))))) 2418 2419 (defun markdown-update-list-levels (marker indent levels) 2420 "Update list levels given list MARKER, block INDENT, and current LEVELS. 2421 Here, MARKER is a string representing the type of list, INDENT is an integer 2422 giving the indentation, in spaces, of the current block, and LEVELS is a 2423 list of the indentation levels of parent list items. When LEVELS is nil, 2424 it means we are at baseline (not inside of a nested list)." 2425 (cond 2426 ;; New list item at baseline. 2427 ((and marker (null levels)) 2428 (setq levels (list indent))) 2429 ;; List item with greater indentation (four or more spaces). 2430 ;; Increase list level. 2431 ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) 2432 (setq levels (cons indent levels))) 2433 ;; List item with greater or equal indentation (less than four spaces). 2434 ;; Do not increase list level. 2435 ((and marker (>= indent (car levels))) 2436 levels) 2437 ;; Lesser indentation level. 2438 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser 2439 ;; indentation could move back more than one list level). Note 2440 ;; that this block need not be the beginning of list item. 2441 ((< indent (car levels)) 2442 (while (and (> (length levels) 1) 2443 (< indent (+ (cadr levels) markdown-list-indent-width))) 2444 (setq levels (cdr levels))) 2445 levels) 2446 ;; Otherwise, do nothing. 2447 (t levels))) 2448 2449 (defun markdown-calculate-list-levels () 2450 "Calculate list levels at point. 2451 Return a list of the form (n1 n2 n3 ...) where n1 is the 2452 indentation of the deepest nested list item in the branch of 2453 the list at the point, n2 is the indentation of the parent 2454 list item, and so on. The depth of the list item is therefore 2455 the length of the returned list. If the point is not at or 2456 immediately after a list item, return nil." 2457 (save-excursion 2458 (let ((first (point)) levels indent pre-regexp) 2459 ;; Find a baseline point with zero list indentation 2460 (markdown-search-backward-baseline) 2461 ;; Search for all list items between baseline and LOC 2462 (while (and (< (point) first) 2463 (re-search-forward markdown-regex-list first t)) 2464 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) 2465 (beginning-of-line) 2466 (cond 2467 ;; Make sure this is not a header or hr 2468 ((markdown-new-baseline) (setq levels nil)) 2469 ;; Make sure this is not a line from a pre block 2470 ((looking-at-p pre-regexp)) 2471 ;; If not, then update levels 2472 (t 2473 (setq indent (current-indentation)) 2474 (setq levels (markdown-update-list-levels (match-string 2) 2475 indent levels)))) 2476 (end-of-line)) 2477 levels))) 2478 2479 (defun markdown-prev-list-item (level) 2480 "Search backward from point for a list item with indentation LEVEL. 2481 Set point to the beginning of the item, and return point, or nil 2482 upon failure." 2483 (let (bounds indent prev) 2484 (setq prev (point)) 2485 (forward-line -1) 2486 (setq indent (current-indentation)) 2487 (while 2488 (cond 2489 ;; List item 2490 ((and (looking-at-p markdown-regex-list) 2491 (setq bounds (markdown-cur-list-item-bounds))) 2492 (cond 2493 ;; Stop and return point at item of equal indentation 2494 ((= (nth 3 bounds) level) 2495 (setq prev (point)) 2496 nil) 2497 ;; Stop and return nil at item with lesser indentation 2498 ((< (nth 3 bounds) level) 2499 (setq prev nil) 2500 nil) 2501 ;; Stop at beginning of buffer 2502 ((bobp) (setq prev nil)) 2503 ;; Continue at item with greater indentation 2504 ((> (nth 3 bounds) level) t))) 2505 ;; Stop at beginning of buffer 2506 ((bobp) (setq prev nil)) 2507 ;; Continue if current line is blank 2508 ((markdown-cur-line-blank-p) t) 2509 ;; Continue while indentation is the same or greater 2510 ((>= indent level) t) 2511 ;; Stop if current indentation is less than list item 2512 ;; and the next is blank 2513 ((and (< indent level) 2514 (markdown-next-line-blank-p)) 2515 (setq prev nil)) 2516 ;; Stop at a header 2517 ((looking-at-p markdown-regex-header) (setq prev nil)) 2518 ;; Stop at a horizontal rule 2519 ((looking-at-p markdown-regex-hr) (setq prev nil)) 2520 ;; Otherwise, continue. 2521 (t t)) 2522 (forward-line -1) 2523 (setq indent (current-indentation))) 2524 prev)) 2525 2526 (defun markdown-next-list-item (level) 2527 "Search forward from point for the next list item with indentation LEVEL. 2528 Set point to the beginning of the item, and return point, or nil 2529 upon failure." 2530 (let (bounds indent next) 2531 (setq next (point)) 2532 (if (looking-at markdown-regex-header-setext) 2533 (goto-char (match-end 0))) 2534 (forward-line) 2535 (setq indent (current-indentation)) 2536 (while 2537 (cond 2538 ;; Stop at end of the buffer. 2539 ((eobp) nil) 2540 ;; Continue if the current line is blank 2541 ((markdown-cur-line-blank-p) t) 2542 ;; List item 2543 ((and (looking-at-p markdown-regex-list) 2544 (setq bounds (markdown-cur-list-item-bounds))) 2545 (cond 2546 ;; Continue at item with greater indentation 2547 ((> (nth 3 bounds) level) t) 2548 ;; Stop and return point at item of equal indentation 2549 ((= (nth 3 bounds) level) 2550 (setq next (point)) 2551 nil) 2552 ;; Stop and return nil at item with lesser indentation 2553 ((< (nth 3 bounds) level) 2554 (setq next nil) 2555 nil))) 2556 ;; Continue while indentation is the same or greater 2557 ((>= indent level) t) 2558 ;; Stop if current indentation is less than list item 2559 ;; and the previous line was blank. 2560 ((and (< indent level) 2561 (markdown-prev-line-blank-p)) 2562 (setq next nil)) 2563 ;; Stop at a header 2564 ((looking-at-p markdown-regex-header) (setq next nil)) 2565 ;; Stop at a horizontal rule 2566 ((looking-at-p markdown-regex-hr) (setq next nil)) 2567 ;; Otherwise, continue. 2568 (t t)) 2569 (forward-line) 2570 (setq indent (current-indentation))) 2571 next)) 2572 2573 (defun markdown-cur-list-item-end (level) 2574 "Move to end of list item with pre-marker indentation LEVEL. 2575 Return the point at the end when a list item was found at the 2576 original point. If the point is not in a list item, do nothing." 2577 (let (indent) 2578 (forward-line) 2579 (setq indent (current-indentation)) 2580 (while 2581 (cond 2582 ;; Stop at end of the buffer. 2583 ((eobp) nil) 2584 ;; Continue while indentation is the same or greater 2585 ((>= indent level) t) 2586 ;; Continue if the current line is blank 2587 ((looking-at markdown-regex-blank-line) t) 2588 ;; Stop if current indentation is less than list item 2589 ;; and the previous line was blank. 2590 ((and (< indent level) 2591 (markdown-prev-line-blank)) 2592 nil) 2593 ;; Stop at a new list items of the same or lesser 2594 ;; indentation, headings, and horizontal rules. 2595 ((looking-at (concat "\\(?:" markdown-regex-list 2596 "\\|" markdown-regex-header 2597 "\\|" markdown-regex-hr "\\)")) 2598 nil) 2599 ;; Otherwise, continue. 2600 (t t)) 2601 (forward-line) 2602 (setq indent (current-indentation))) 2603 ;; Don't skip over whitespace for empty list items (marker and 2604 ;; whitespace only), just move to end of whitespace. 2605 (if (save-excursion 2606 (beginning-of-line) 2607 (looking-at (concat markdown-regex-list "[ \t]*$"))) 2608 (goto-char (match-end 3)) 2609 (skip-chars-backward " \t\n")) 2610 (end-of-line) 2611 (point))) 2612 2613 (defun markdown-cur-list-item-bounds () 2614 "Return bounds for list item at point. 2615 Return a list of the following form: 2616 2617 (begin end indent nonlist-indent marker checkbox match) 2618 2619 The named components are: 2620 2621 - begin: Position of beginning of list item, including leading indentation. 2622 - end: Position of the end of the list item, including list item text. 2623 - indent: Number of characters of indentation before list marker (an integer). 2624 - nonlist-indent: Number characters of indentation, list 2625 marker, and whitespace following list marker (an integer). 2626 - marker: String containing the list marker and following whitespace 2627 (e.g., \"- \" or \"* \"). 2628 - checkbox: String containing the GFM checkbox portion, if any, 2629 including any trailing whitespace before the text 2630 begins (e.g., \"[x] \"). 2631 - match: match data for markdown-regex-list 2632 2633 As an example, for the following unordered list item 2634 2635 - item 2636 2637 the returned list would be 2638 2639 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) 2640 2641 If the point is not inside a list item, return nil." 2642 (car (get-text-property (line-beginning-position) 'markdown-list-item))) 2643 2644 (defun markdown-list-item-at-point-p () 2645 "Return t if there is a list item at the point and nil otherwise." 2646 (save-match-data (markdown-cur-list-item-bounds))) 2647 2648 (defun markdown-prev-list-item-bounds () 2649 "Return bounds of previous item in the same list of any level. 2650 The return value has the same form as that of 2651 `markdown-cur-list-item-bounds'." 2652 (save-excursion 2653 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2654 (beginning-of-list (save-excursion (markdown-beginning-of-list))) 2655 stop) 2656 (when cur-bounds 2657 (goto-char (nth 0 cur-bounds)) 2658 (while (and (not stop) (not (bobp)) 2659 (re-search-backward markdown-regex-list 2660 beginning-of-list t)) 2661 (unless (or (looking-at markdown-regex-hr) 2662 (markdown-code-block-at-point-p)) 2663 (setq stop (point)))) 2664 (markdown-cur-list-item-bounds))))) 2665 2666 (defun markdown-next-list-item-bounds () 2667 "Return bounds of next item in the same list of any level. 2668 The return value has the same form as that of 2669 `markdown-cur-list-item-bounds'." 2670 (save-excursion 2671 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2672 (end-of-list (save-excursion (markdown-end-of-list))) 2673 stop) 2674 (when cur-bounds 2675 (goto-char (nth 0 cur-bounds)) 2676 (end-of-line) 2677 (while (and (not stop) (not (eobp)) 2678 (re-search-forward markdown-regex-list 2679 end-of-list t)) 2680 (unless (or (looking-at markdown-regex-hr) 2681 (markdown-code-block-at-point-p)) 2682 (setq stop (point)))) 2683 (when stop 2684 (markdown-cur-list-item-bounds)))))) 2685 2686 (defun markdown-beginning-of-list () 2687 "Move point to beginning of list at point, if any." 2688 (interactive) 2689 (let ((orig-point (point)) 2690 (list-begin (save-excursion 2691 (markdown-search-backward-baseline) 2692 ;; Stop at next list item, regardless of the indentation. 2693 (markdown-next-list-item (point-max)) 2694 (when (looking-at markdown-regex-list) 2695 (point))))) 2696 (when (and list-begin (<= list-begin orig-point)) 2697 (goto-char list-begin)))) 2698 2699 (defun markdown-end-of-list () 2700 "Move point to end of list at point, if any." 2701 (interactive) 2702 (let ((start (point)) 2703 (end (save-excursion 2704 (when (markdown-beginning-of-list) 2705 ;; Items can't have nonlist-indent <= 1, so this 2706 ;; moves past all list items. 2707 (markdown-next-list-item 1) 2708 (skip-syntax-backward "-") 2709 (unless (eobp) (forward-char 1)) 2710 (point))))) 2711 (when (and end (>= end start)) 2712 (goto-char end)))) 2713 2714 (defun markdown-up-list () 2715 "Move point to beginning of parent list item." 2716 (interactive) 2717 (let ((cur-bounds (markdown-cur-list-item-bounds))) 2718 (when cur-bounds 2719 (markdown-prev-list-item (1- (nth 3 cur-bounds))) 2720 (let ((up-bounds (markdown-cur-list-item-bounds))) 2721 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) 2722 (point)))))) 2723 2724 (defun markdown-bounds-of-thing-at-point (thing) 2725 "Call `bounds-of-thing-at-point' for THING with slight modifications. 2726 Does not include trailing newlines when THING is \\='line. Handles the 2727 end of buffer case by setting both endpoints equal to the value of 2728 `point-max', since an empty region will trigger empty markup insertion. 2729 Return bounds of form (beg . end) if THING is found, or nil otherwise." 2730 (let* ((bounds (bounds-of-thing-at-point thing)) 2731 (a (car bounds)) 2732 (b (cdr bounds))) 2733 (when bounds 2734 (when (eq thing 'line) 2735 (cond ((and (eobp) (markdown-cur-line-blank-p)) 2736 (setq a b)) 2737 ((char-equal (char-before b) ?\^J) 2738 (setq b (1- b))))) 2739 (cons a b)))) 2740 2741 (defun markdown-reference-definition (reference) 2742 "Find out whether Markdown REFERENCE is defined. 2743 REFERENCE should not include the square brackets. 2744 When REFERENCE is defined, return a list of the form (text start end) 2745 containing the definition text itself followed by the start and end 2746 locations of the text. Otherwise, return nil. 2747 Leave match data for `markdown-regex-reference-definition' 2748 intact additional processing." 2749 (let ((reference (downcase reference))) 2750 (save-excursion 2751 (goto-char (point-min)) 2752 (catch 'found 2753 (while (re-search-forward markdown-regex-reference-definition nil t) 2754 (when (string= reference (downcase (match-string-no-properties 2))) 2755 (throw 'found 2756 (list (match-string-no-properties 5) 2757 (match-beginning 5) (match-end 5))))))))) 2758 2759 (defun markdown-get-defined-references () 2760 "Return all defined reference labels and their line numbers. 2761 They does not include square brackets)." 2762 (save-excursion 2763 (goto-char (point-min)) 2764 (let (refs) 2765 (while (re-search-forward markdown-regex-reference-definition nil t) 2766 (let ((target (match-string-no-properties 2))) 2767 (cl-pushnew 2768 (cons (downcase target) 2769 (markdown-line-number-at-pos (match-beginning 2))) 2770 refs :test #'equal :key #'car))) 2771 (reverse refs)))) 2772 2773 (defun markdown-get-used-uris () 2774 "Return a list of all used URIs in the buffer." 2775 (save-excursion 2776 (goto-char (point-min)) 2777 (let (uris) 2778 (while (re-search-forward 2779 (concat "\\(?:" markdown-regex-link-inline 2780 "\\|" markdown-regex-angle-uri 2781 "\\|" markdown-regex-uri 2782 "\\|" markdown-regex-email 2783 "\\)") 2784 nil t) 2785 (unless (or (markdown-inline-code-at-point-p) 2786 (markdown-code-block-at-point-p)) 2787 (cl-pushnew (or (match-string-no-properties 6) 2788 (match-string-no-properties 10) 2789 (match-string-no-properties 12) 2790 (match-string-no-properties 13)) 2791 uris :test #'equal))) 2792 (reverse uris)))) 2793 2794 (defun markdown-inline-code-at-pos (pos &optional from) 2795 "Return non-nil if there is an inline code fragment at POS starting at FROM. 2796 Uses the beginning of the block if FROM is nil. 2797 Return nil otherwise. Set match data according to 2798 `markdown-match-code' upon success. 2799 This function searches the block for a code fragment that 2800 contains the point using `markdown-match-code'. We do this 2801 because `thing-at-point-looking-at' does not work reliably with 2802 `markdown-regex-code'. 2803 2804 The match data is set as follows: 2805 Group 1 matches the opening backquotes. 2806 Group 2 matches the code fragment itself, without backquotes. 2807 Group 3 matches the closing backquotes." 2808 (save-excursion 2809 (goto-char pos) 2810 (let ((old-point (point)) 2811 (end-of-block (progn (markdown-end-of-text-block) (point))) 2812 found) 2813 (if from 2814 (goto-char from) 2815 (markdown-beginning-of-text-block)) 2816 (while (and (markdown-match-code end-of-block) 2817 (setq found t) 2818 (< (match-end 0) old-point))) 2819 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) 2820 (and found ; matched something 2821 (<= (match-beginning match-group) old-point) ; match contains old-point 2822 (> (match-end 0) old-point)))))) 2823 2824 (defun markdown-inline-code-at-pos-p (pos) 2825 "Return non-nil if there is an inline code fragment at POS. 2826 Like `markdown-inline-code-at-pos`, but preserves match data." 2827 (save-match-data (markdown-inline-code-at-pos pos))) 2828 2829 (defun markdown-inline-code-at-point () 2830 "Return non-nil if the point is at an inline code fragment. 2831 See `markdown-inline-code-at-pos' for details." 2832 (markdown-inline-code-at-pos (point))) 2833 2834 (defun markdown-inline-code-at-point-p (&optional pos) 2835 "Return non-nil if there is inline code at the POS. 2836 This is a predicate function counterpart to 2837 `markdown-inline-code-at-point' which does not modify the match 2838 data. See `markdown-code-block-at-point-p' for code blocks." 2839 (save-match-data (markdown-inline-code-at-pos (or pos (point))))) 2840 2841 (defun markdown-code-block-at-pos (pos) 2842 "Return match data list if there is a code block at POS. 2843 Uses text properties at the beginning of the line position. 2844 This includes pre blocks, tilde-fenced code blocks, and GFM 2845 quoted code blocks. Return nil otherwise." 2846 (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) 2847 (or (get-text-property bol 'markdown-pre) 2848 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) 2849 (second (cl-second bounds))) 2850 (if second 2851 ;; chunks are right open 2852 (when (< pos second) 2853 bounds) 2854 bounds))))) 2855 2856 ;; Function was renamed to emphasize that it does not modify match-data. 2857 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) 2858 2859 (defun markdown-code-block-at-point-p (&optional pos) 2860 "Return non-nil if there is a code block at the POS. 2861 This includes pre blocks, tilde-fenced code blocks, and GFM 2862 quoted code blocks. This function does not modify the match 2863 data. See `markdown-inline-code-at-point-p' for inline code." 2864 (save-match-data (markdown-code-block-at-pos (or pos (point))))) 2865 2866 (defun markdown-heading-at-point (&optional pos) 2867 "Return non-nil if there is a heading at the POS. 2868 Set match data for `markdown-regex-header'." 2869 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) 2870 (when match-data 2871 (set-match-data match-data) 2872 t))) 2873 2874 (defun markdown-pipe-at-bol-p () 2875 "Return non-nil if the line begins with a pipe symbol. 2876 This may be useful for tables and Pandoc's line_blocks extension." 2877 (char-equal (char-after (line-beginning-position)) ?|)) 2878 2879 2880 ;;; Markdown Font Lock Matching Functions ===================================== 2881 2882 (defun markdown-range-property-any (begin end prop prop-values) 2883 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. 2884 Also returns t if PROP is a list containing one of the PROP-VALUES. 2885 Return nil otherwise." 2886 (let (props) 2887 (catch 'found 2888 (dolist (loc (number-sequence begin end)) 2889 (when (setq props (get-text-property loc prop)) 2890 (cond ((listp props) 2891 ;; props is a list, check for membership 2892 (dolist (val prop-values) 2893 (when (memq val props) (throw 'found loc)))) 2894 (t 2895 ;; props is a scalar, check for equality 2896 (dolist (val prop-values) 2897 (when (eq val props) (throw 'found loc)))))))))) 2898 2899 (defun markdown-range-properties-exist (begin end props) 2900 (cl-loop 2901 for loc in (number-sequence begin end) 2902 with result = nil 2903 while (not 2904 (setq result 2905 (cl-some (lambda (prop) (get-text-property loc prop)) props))) 2906 finally return result)) 2907 2908 (defun markdown-match-inline-generic (regex last &optional faceless) 2909 "Match inline REGEX from the point to LAST. 2910 When FACELESS is non-nil, do not return matches where faces have been applied." 2911 (when (re-search-forward regex last t) 2912 (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) 2913 (face (and faceless (text-property-not-all 2914 (match-beginning 0) (match-end 0) 'face nil)))) 2915 (cond 2916 ;; In code block: move past it and recursively search again 2917 (bounds 2918 (when (< (goto-char (cl-second bounds)) last) 2919 (markdown-match-inline-generic regex last faceless))) 2920 ;; When faces are found in the match range, skip over the match and 2921 ;; recursively search again. 2922 (face 2923 (when (< (goto-char (match-end 0)) last) 2924 (markdown-match-inline-generic regex last faceless))) 2925 ;; Keep match data and return t when in bounds. 2926 (t 2927 (<= (match-end 0) last)))))) 2928 2929 (defun markdown-match-code (last) 2930 "Match inline code fragments from point to LAST." 2931 (unless (bobp) 2932 (backward-char 1)) 2933 (when (markdown-search-until-condition 2934 (lambda () 2935 (and 2936 ;; Advance point in case of failure, but without exceeding last. 2937 (goto-char (min (1+ (match-beginning 1)) last)) 2938 (not (markdown-in-comment-p (match-beginning 1))) 2939 (not (markdown-in-comment-p (match-end 1))) 2940 (not (markdown-code-block-at-pos (match-beginning 1))))) 2941 markdown-regex-code last t) 2942 (set-match-data (list (match-beginning 1) (match-end 1) 2943 (match-beginning 2) (match-end 2) 2944 (match-beginning 3) (match-end 3) 2945 (match-beginning 4) (match-end 4))) 2946 (goto-char (min (1+ (match-end 0)) last (point-max))) 2947 t)) 2948 2949 (defun markdown--gfm-markup-underscore-p (begin end) 2950 (let ((is-underscore (eql (char-after begin) ?_))) 2951 (if (not is-underscore) 2952 t 2953 (save-excursion 2954 (save-match-data 2955 (goto-char begin) 2956 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) 2957 (progn 2958 (goto-char end) 2959 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) 2960 2961 (defun markdown-match-bold (last) 2962 "Match inline bold from the point to LAST." 2963 (let (done 2964 retval 2965 last-inline-code) 2966 (while (not done) 2967 (if (markdown-match-inline-generic markdown-regex-bold last) 2968 (let ((is-gfm (derived-mode-p 'gfm-mode)) 2969 (begin (match-beginning 2)) 2970 (end (match-end 2))) 2971 (if (or 2972 (and last-inline-code 2973 (>= begin (car last-inline-code)) 2974 (< begin (cdr last-inline-code))) 2975 (save-match-data 2976 (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) 2977 (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) 2978 (markdown-inline-code-at-pos-p end) 2979 (markdown-in-comment-p) 2980 (markdown-range-property-any 2981 begin begin 'face '(markdown-url-face 2982 markdown-plain-url-face)) 2983 (markdown-range-property-any 2984 begin end 'face '(markdown-hr-face 2985 markdown-math-face)) 2986 (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) 2987 (progn (goto-char (min (1+ begin) last)) 2988 (unless (< (point) last) 2989 (setq 2990 done t))) 2991 (set-match-data (list (match-beginning 2) (match-end 2) 2992 (match-beginning 3) (match-end 3) 2993 (match-beginning 4) (match-end 4) 2994 (match-beginning 5) (match-end 5))) 2995 (setq done t 2996 retval t))) 2997 (setq done t))) 2998 retval)) 2999 3000 (defun markdown-match-italic (last) 3001 "Match inline italics from the point to LAST." 3002 (let* ((is-gfm (derived-mode-p 'gfm-mode)) 3003 (regex (if is-gfm 3004 markdown-regex-gfm-italic 3005 markdown-regex-italic))) 3006 (let (done 3007 retval 3008 last-inline-code) 3009 (while (not done) 3010 (if (and (markdown-match-inline-generic regex last) 3011 (not (markdown--face-p 3012 (match-beginning 1) 3013 '(markdown-html-attr-name-face markdown-html-attr-value-face)))) 3014 (let ((begin (match-beginning 1)) 3015 (end (match-end 1)) 3016 (close-end (match-end 4))) 3017 (if (or (eql (char-before begin) (char-after begin)) 3018 (and last-inline-code 3019 (>= begin (car last-inline-code)) 3020 (< begin (cdr last-inline-code))) 3021 (save-match-data 3022 (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) 3023 (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) 3024 3025 (markdown-inline-code-at-pos-p (1- end)) 3026 (markdown-in-comment-p) 3027 (markdown-range-property-any 3028 begin begin 'face '(markdown-url-face 3029 markdown-plain-url-face 3030 markdown-markup-face)) 3031 (markdown-range-property-any 3032 begin end 'face '(markdown-bold-face 3033 markdown-list-face 3034 markdown-hr-face 3035 markdown-math-face)) 3036 (and is-gfm 3037 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case 3038 (not (markdown--gfm-markup-underscore-p begin close-end))))) 3039 (progn (goto-char (min (1+ begin) last)) 3040 (unless (< (point) last) 3041 (setq 3042 done t))) 3043 (set-match-data (list (match-beginning 1) (match-end 1) 3044 (match-beginning 2) (match-end 2) 3045 (match-beginning 3) (match-end 3) 3046 (match-beginning 4) (match-end 4))) 3047 (setq done t 3048 retval t))) 3049 (setq done t))) 3050 retval))) 3051 3052 (defun markdown--match-highlighting (last) 3053 (when markdown-enable-highlighting-syntax 3054 (re-search-forward markdown-regex-highlighting last t))) 3055 3056 (defun markdown-match-escape (last) 3057 "Match escape characters (backslashes) from point to LAST. 3058 Backlashes only count as escape characters outside of literal 3059 regions (e.g. code blocks). See `markdown-literal-faces'." 3060 (catch 'found 3061 (while (search-forward-regexp markdown-regex-escape last t) 3062 (let* ((face (get-text-property (match-beginning 1) 'face)) 3063 (face-list (if (listp face) face (list face)))) 3064 ;; Ignore any backslashes with a literal face. 3065 (unless (cl-intersection face-list markdown-literal-faces) 3066 (throw 'found t)))))) 3067 3068 (defun markdown-match-math-generic (regex last) 3069 "Match REGEX from point to LAST. 3070 REGEX is either `markdown-regex-math-inline-single' for matching 3071 $..$ or `markdown-regex-math-inline-double' for matching $$..$$." 3072 (when (markdown-match-inline-generic regex last) 3073 (let ((begin (match-beginning 1)) (end (match-end 1))) 3074 (prog1 3075 (if (or (markdown-range-property-any 3076 begin end 'face 3077 '(markdown-inline-code-face markdown-bold-face)) 3078 (markdown-range-properties-exist 3079 begin end 3080 (markdown-get-fenced-block-middle-properties))) 3081 (markdown-match-math-generic regex last) 3082 t) 3083 (goto-char (1+ (match-end 0))))))) 3084 3085 (defun markdown-match-list-items (last) 3086 "Match list items from point to LAST." 3087 (let* ((first (point)) 3088 (pos first) 3089 (prop 'markdown-list-item) 3090 (bounds (car (get-text-property pos prop)))) 3091 (while 3092 (and (or (null (setq bounds (car (get-text-property pos prop)))) 3093 (< (cl-first bounds) pos)) 3094 (< (point) last) 3095 (setq pos (next-single-property-change pos prop nil last)) 3096 (goto-char pos))) 3097 (when bounds 3098 (set-match-data (cl-seventh bounds)) 3099 ;; Step at least one character beyond point. Otherwise 3100 ;; `font-lock-fontify-keywords-region' infloops. 3101 (goto-char (min (1+ (max (line-end-position) first)) 3102 (point-max))) 3103 t))) 3104 3105 (defun markdown-match-math-single (last) 3106 "Match single quoted $..$ math from point to LAST." 3107 (when markdown-enable-math 3108 (when (and (char-equal (char-after) ?$) 3109 (not (bolp)) 3110 (not (char-equal (char-before) ?\\)) 3111 (not (char-equal (char-before) ?$))) 3112 (forward-char -1)) 3113 (markdown-match-math-generic markdown-regex-math-inline-single last))) 3114 3115 (defun markdown-match-math-double (last) 3116 "Match double quoted $$..$$ math from point to LAST." 3117 (when markdown-enable-math 3118 (when (and (< (1+ (point)) (point-max)) 3119 (char-equal (char-after) ?$) 3120 (char-equal (char-after (1+ (point))) ?$) 3121 (not (bolp)) 3122 (not (char-equal (char-before) ?\\)) 3123 (not (char-equal (char-before) ?$))) 3124 (forward-char -1)) 3125 (markdown-match-math-generic markdown-regex-math-inline-double last))) 3126 3127 (defun markdown-match-math-display (last) 3128 "Match bracketed display math \[..\] and \\[..\\] from point to LAST." 3129 (when markdown-enable-math 3130 (markdown-match-math-generic markdown-regex-math-display last))) 3131 3132 (defun markdown-match-propertized-text (property last) 3133 "Match text with PROPERTY from point to LAST. 3134 Restore match data previously stored in PROPERTY." 3135 (let ((saved (get-text-property (point) property)) 3136 pos) 3137 (unless saved 3138 (setq pos (next-single-property-change (point) property nil last)) 3139 (unless (= pos last) 3140 (setq saved (get-text-property pos property)))) 3141 (when saved 3142 (set-match-data saved) 3143 ;; Step at least one character beyond point. Otherwise 3144 ;; `font-lock-fontify-keywords-region' infloops. 3145 (goto-char (min (1+ (max (match-end 0) (point))) 3146 (point-max))) 3147 saved))) 3148 3149 (defun markdown-match-pre-blocks (last) 3150 "Match preformatted blocks from point to LAST. 3151 Use data stored in \\='markdown-pre text property during syntax 3152 analysis." 3153 (markdown-match-propertized-text 'markdown-pre last)) 3154 3155 (defun markdown-match-gfm-code-blocks (last) 3156 "Match GFM quoted code blocks from point to LAST. 3157 Use data stored in \\='markdown-gfm-code text property during syntax 3158 analysis." 3159 (markdown-match-propertized-text 'markdown-gfm-code last)) 3160 3161 (defun markdown-match-gfm-open-code-blocks (last) 3162 (markdown-match-propertized-text 'markdown-gfm-block-begin last)) 3163 3164 (defun markdown-match-gfm-close-code-blocks (last) 3165 (markdown-match-propertized-text 'markdown-gfm-block-end last)) 3166 3167 (defun markdown-match-fenced-code-blocks (last) 3168 "Match fenced code blocks from the point to LAST." 3169 (markdown-match-propertized-text 'markdown-fenced-code last)) 3170 3171 (defun markdown-match-fenced-start-code-block (last) 3172 (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) 3173 3174 (defun markdown-match-fenced-end-code-block (last) 3175 (markdown-match-propertized-text 'markdown-tilde-fence-end last)) 3176 3177 (defun markdown-match-blockquotes (last) 3178 "Match blockquotes from point to LAST. 3179 Use data stored in \\='markdown-blockquote text property during syntax 3180 analysis." 3181 (markdown-match-propertized-text 'markdown-blockquote last)) 3182 3183 (defun markdown-match-hr (last) 3184 "Match horizontal rules comments from the point to LAST." 3185 (markdown-match-propertized-text 'markdown-hr last)) 3186 3187 (defun markdown-match-comments (last) 3188 "Match HTML comments from the point to LAST." 3189 (when (and (skip-syntax-forward "^<" last)) 3190 (let ((beg (point))) 3191 (when (and (skip-syntax-forward "^>" last) (< (point) last)) 3192 (forward-char) 3193 (set-match-data (list beg (point))) 3194 t)))) 3195 3196 (defun markdown-match-generic-links (last ref) 3197 "Match inline links from point to LAST. 3198 When REF is non-nil, match reference links instead of standard 3199 links with URLs. 3200 This function should only be used during font-lock, as it 3201 determines syntax based on the presence of faces for previously 3202 processed elements." 3203 ;; Search for the next potential link (not in a code block). 3204 (let ((prohibited-faces '(markdown-pre-face 3205 markdown-code-face 3206 markdown-inline-code-face 3207 markdown-comment-face)) 3208 found) 3209 (while 3210 (and (not found) (< (point) last) 3211 (progn 3212 ;; Clear match data to test for a match after functions returns. 3213 (set-match-data nil) 3214 ;; Preliminary regular expression search so we can return 3215 ;; quickly upon failure. This doesn't handle malformed links 3216 ;; or nested square brackets well, so if it passes we back up 3217 ;; continue with a more precise search. 3218 (re-search-forward 3219 (if ref 3220 markdown-regex-link-reference 3221 markdown-regex-link-inline) 3222 last 'limit))) 3223 ;; Keep searching if this is in a code block, inline code, or a 3224 ;; comment, or if it is include syntax. The link text portion 3225 ;; (group 3) may contain inline code or comments, but the 3226 ;; markup, URL, and title should not be part of such elements. 3227 (if (or (markdown-range-property-any 3228 (match-beginning 0) (match-end 2) 'face prohibited-faces) 3229 (markdown-range-property-any 3230 (match-beginning 4) (match-end 0) 'face prohibited-faces) 3231 (and (char-equal (char-after (line-beginning-position)) ?<) 3232 (char-equal (char-after (1+ (line-beginning-position))) ?<))) 3233 (set-match-data nil) 3234 (setq found t)))) 3235 ;; Match opening exclamation point (optional) and left bracket. 3236 (when (match-beginning 2) 3237 (let* ((bang (match-beginning 1)) 3238 (first-begin (match-beginning 2)) 3239 ;; Find end of block to prevent matching across blocks. 3240 (end-of-block (save-excursion 3241 (progn 3242 (goto-char (match-beginning 2)) 3243 (markdown-end-of-text-block) 3244 (point)))) 3245 ;; Move over balanced expressions to closing right bracket. 3246 ;; Catch unbalanced expression errors and return nil. 3247 (first-end (condition-case nil 3248 (and (goto-char first-begin) 3249 (scan-sexps (point) 1)) 3250 (error nil))) 3251 ;; Continue with point at CONT-POINT upon failure. 3252 (cont-point (min (1+ first-begin) last)) 3253 second-begin second-end url-begin url-end 3254 title-begin title-end) 3255 ;; When bracket found, in range, and followed by a left paren/bracket... 3256 (when (and first-end (< first-end end-of-block) (goto-char first-end) 3257 (char-equal (char-after (point)) (if ref ?\[ ?\())) 3258 ;; Scan across balanced expressions for closing parenthesis/bracket. 3259 (setq second-begin (point) 3260 second-end (condition-case nil 3261 (scan-sexps (point) 1) 3262 (error nil))) 3263 ;; Check that closing parenthesis/bracket is in range. 3264 (if (and second-end (<= second-end end-of-block) (<= second-end last)) 3265 (progn 3266 ;; Search for (optional) title inside closing parenthesis 3267 (when (and (not ref) (search-forward "\"" second-end t)) 3268 (setq title-begin (1- (point)) 3269 title-end (and (goto-char second-end) 3270 (search-backward "\"" (1+ title-begin) t)) 3271 title-end (and title-end (1+ title-end)))) 3272 ;; Store URL/reference range 3273 (setq url-begin (1+ second-begin) 3274 url-end (1- (or title-begin second-end))) 3275 ;; Set match data, move point beyond link, and return 3276 (set-match-data 3277 (list (or bang first-begin) second-end ; 0 - all 3278 bang (and bang (1+ bang)) ; 1 - bang 3279 first-begin (1+ first-begin) ; 2 - markup 3280 (1+ first-begin) (1- first-end) ; 3 - link text 3281 (1- first-end) first-end ; 4 - markup 3282 second-begin (1+ second-begin) ; 5 - markup 3283 url-begin url-end ; 6 - url/reference 3284 title-begin title-end ; 7 - title 3285 (1- second-end) second-end)) ; 8 - markup 3286 ;; Nullify cont-point and leave point at end and 3287 (setq cont-point nil) 3288 (goto-char second-end)) 3289 ;; If no closing parenthesis in range, update continuation point 3290 (setq cont-point (min end-of-block second-begin)))) 3291 (cond 3292 ;; On failure, continue searching at cont-point 3293 ((and cont-point (< cont-point last)) 3294 (goto-char cont-point) 3295 (markdown-match-generic-links last ref)) 3296 ;; No more text, return nil 3297 ((and cont-point (= cont-point last)) 3298 nil) 3299 ;; Return t if a match occurred 3300 (t t))))) 3301 3302 (defun markdown-match-angle-uris (last) 3303 "Match angle bracket URIs from point to LAST." 3304 (when (markdown-match-inline-generic markdown-regex-angle-uri last) 3305 (goto-char (1+ (match-end 0))))) 3306 3307 (defun markdown-match-plain-uris (last) 3308 "Match plain URIs from point to LAST." 3309 (when (markdown-match-inline-generic markdown-regex-uri last t) 3310 (goto-char (1+ (match-end 0))))) 3311 3312 (defvar markdown-conditional-search-function #'re-search-forward 3313 "Conditional search function used in `markdown-search-until-condition'. 3314 Made into a variable to allow for dynamic let-binding.") 3315 3316 (defun markdown-search-until-condition (condition &rest args) 3317 (let (ret) 3318 (while (and (not ret) (apply markdown-conditional-search-function args)) 3319 (setq ret (funcall condition))) 3320 ret)) 3321 3322 (defun markdown-metadata-line-p (pos regexp) 3323 (save-excursion 3324 (or (= (line-number-at-pos pos) 1) 3325 (progn 3326 (forward-line -1) 3327 ;; skip multi-line metadata 3328 (while (and (looking-at-p "^\\s-+[[:alpha:]]") 3329 (> (line-number-at-pos (point)) 1)) 3330 (forward-line -1)) 3331 (looking-at-p regexp))))) 3332 3333 (defun markdown-match-generic-metadata (regexp last) 3334 "Match metadata declarations specified by REGEXP from point to LAST. 3335 These declarations must appear inside a metadata block that begins at 3336 the beginning of the buffer and ends with a blank line (or the end of 3337 the buffer)." 3338 (let* ((first (point)) 3339 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") 3340 (block-begin (goto-char 1)) 3341 (block-end (re-search-forward end-re nil t))) 3342 (if (and block-end (> first block-end)) 3343 ;; Don't match declarations if there is no metadata block or if 3344 ;; the point is beyond the block. Move point to point-max to 3345 ;; prevent additional searches and return return nil since nothing 3346 ;; was found. 3347 (progn (goto-char (point-max)) nil) 3348 ;; If a block was found that begins before LAST and ends after 3349 ;; point, search for declarations inside it. If the starting is 3350 ;; before the beginning of the block, start there. Otherwise, 3351 ;; move back to FIRST. 3352 (goto-char (if (< first block-begin) block-begin first)) 3353 (if (and (re-search-forward regexp (min last block-end) t) 3354 (markdown-metadata-line-p (point) regexp)) 3355 ;; If a metadata declaration is found, set match-data and return t. 3356 (let ((key-beginning (match-beginning 1)) 3357 (key-end (match-end 1)) 3358 (markup-begin (match-beginning 2)) 3359 (markup-end (match-end 2)) 3360 (value-beginning (match-beginning 3))) 3361 (set-match-data (list key-beginning (point) ; complete metadata 3362 key-beginning key-end ; key 3363 markup-begin markup-end ; markup 3364 value-beginning (point))) ; value 3365 t) 3366 ;; Otherwise, move the point to last and return nil 3367 (goto-char last) 3368 nil)))) 3369 3370 (defun markdown-match-declarative-metadata (last) 3371 "Match declarative metadata from the point to LAST." 3372 (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) 3373 3374 (defun markdown-match-pandoc-metadata (last) 3375 "Match Pandoc metadata from the point to LAST." 3376 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) 3377 3378 (defun markdown-match-yaml-metadata-begin (last) 3379 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) 3380 3381 (defun markdown-match-yaml-metadata-end (last) 3382 (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) 3383 3384 (defun markdown-match-yaml-metadata-key (last) 3385 (markdown-match-propertized-text 'markdown-metadata-key last)) 3386 3387 (defun markdown-match-wiki-link (last) 3388 "Match wiki links from point to LAST." 3389 (when (and markdown-enable-wiki-links 3390 (not markdown-wiki-link-fontify-missing) 3391 (markdown-match-inline-generic markdown-regex-wiki-link last)) 3392 (let ((begin (match-beginning 1)) (end (match-end 1))) 3393 (if (or (markdown-in-comment-p begin) 3394 (markdown-in-comment-p end) 3395 (markdown-inline-code-at-pos-p begin) 3396 (markdown-inline-code-at-pos-p end) 3397 (markdown-code-block-at-pos begin)) 3398 (progn (goto-char (min (1+ begin) last)) 3399 (when (< (point) last) 3400 (markdown-match-wiki-link last))) 3401 (set-match-data (list begin end)) 3402 t)))) 3403 3404 (defun markdown-match-inline-attributes (last) 3405 "Match inline attributes from point to LAST." 3406 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. 3407 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes 3408 ;; against matched string. 3409 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) 3410 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) 3411 (markdown-match-inline-attributes last) 3412 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3413 (markdown-inline-code-at-pos-p (match-end 0)) 3414 (markdown-in-comment-p)) 3415 t)))) 3416 3417 (defun markdown-match-leanpub-sections (last) 3418 "Match Leanpub section markers from point to LAST." 3419 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) 3420 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3421 (markdown-inline-code-at-pos-p (match-end 0)) 3422 (markdown-in-comment-p)) 3423 t))) 3424 3425 (defun markdown-match-includes (last) 3426 "Match include statements from point to LAST. 3427 Sets match data for the following seven groups: 3428 Group 1: opening two angle brackets 3429 Group 2: opening title delimiter (optional) 3430 Group 3: title text (optional) 3431 Group 4: closing title delimiter (optional) 3432 Group 5: opening filename delimiter 3433 Group 6: filename 3434 Group 7: closing filename delimiter" 3435 (when (markdown-match-inline-generic markdown-regex-include last) 3436 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) 3437 (markdown-in-comment-p (match-end 0)) 3438 (markdown-code-block-at-pos (match-beginning 0)))))) 3439 (cond 3440 ;; Parentheses and maybe square brackets, but no curly braces: 3441 ;; match optional title in square brackets and file in parentheses. 3442 ((and valid (match-beginning 5) 3443 (not (match-beginning 8))) 3444 (set-match-data (list (match-beginning 1) (match-end 7) 3445 (match-beginning 1) (match-end 1) 3446 (match-beginning 2) (match-end 2) 3447 (match-beginning 3) (match-end 3) 3448 (match-beginning 4) (match-end 4) 3449 (match-beginning 5) (match-end 5) 3450 (match-beginning 6) (match-end 6) 3451 (match-beginning 7) (match-end 7)))) 3452 ;; Only square brackets present: match file in square brackets. 3453 ((and valid (match-beginning 2) 3454 (not (match-beginning 5)) 3455 (not (match-beginning 7))) 3456 (set-match-data (list (match-beginning 1) (match-end 4) 3457 (match-beginning 1) (match-end 1) 3458 nil nil 3459 nil nil 3460 nil nil 3461 (match-beginning 2) (match-end 2) 3462 (match-beginning 3) (match-end 3) 3463 (match-beginning 4) (match-end 4)))) 3464 ;; Only curly braces present: match file in curly braces. 3465 ((and valid (match-beginning 8) 3466 (not (match-beginning 2)) 3467 (not (match-beginning 5))) 3468 (set-match-data (list (match-beginning 1) (match-end 10) 3469 (match-beginning 1) (match-end 1) 3470 nil nil 3471 nil nil 3472 nil nil 3473 (match-beginning 8) (match-end 8) 3474 (match-beginning 9) (match-end 9) 3475 (match-beginning 10) (match-end 10)))) 3476 (t 3477 ;; Not a valid match, move to next line and search again. 3478 (forward-line) 3479 (when (< (point) last) 3480 (setq valid (markdown-match-includes last))))) 3481 valid))) 3482 3483 (defun markdown-match-html-tag (last) 3484 "Match HTML tags from point to LAST." 3485 (when (and markdown-enable-html 3486 (markdown-match-inline-generic markdown-regex-html-tag last t)) 3487 (set-match-data (list (match-beginning 0) (match-end 0) 3488 (match-beginning 1) (match-end 1) 3489 (match-beginning 2) (match-end 2) 3490 (match-beginning 9) (match-end 9))) 3491 t)) 3492 3493 3494 ;;; Markdown Font Fontification Functions ===================================== 3495 3496 (defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) 3497 3498 (defun markdown--first-displayable (seq) 3499 "Return the first displayable character or string in SEQ. 3500 SEQ may be an atom or a sequence." 3501 (let ((c (gethash seq markdown--first-displayable-cache t))) 3502 (if (not (eq c t)) 3503 c 3504 (puthash seq 3505 (let ((seq (if (listp seq) seq (list seq)))) 3506 (cond ((stringp (car seq)) 3507 (cl-find-if 3508 (lambda (str) 3509 (and (mapcar #'char-displayable-p (string-to-list str)))) 3510 seq)) 3511 ((characterp (car seq)) 3512 (cl-find-if #'char-displayable-p seq)))) 3513 markdown--first-displayable-cache)))) 3514 3515 (defun markdown--marginalize-string (level) 3516 "Generate atx markup string of given LEVEL for left margin." 3517 (let ((margin-left-space-count 3518 (- markdown-marginalize-headers-margin-width level))) 3519 (concat (make-string margin-left-space-count ? ) 3520 (make-string level ?#)))) 3521 3522 (defun markdown-marginalize-update-current () 3523 "Update the window configuration to create a left margin." 3524 (if window-system 3525 (let* ((header-delimiter-font-width 3526 (window-font-width nil 'markdown-header-delimiter-face)) 3527 (margin-pixel-width (* markdown-marginalize-headers-margin-width 3528 header-delimiter-font-width)) 3529 (margin-char-width (/ margin-pixel-width (default-font-width)))) 3530 (set-window-margins nil margin-char-width)) 3531 ;; As a fallback, simply set margin based on character count. 3532 (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) 3533 3534 (defun markdown-fontify-headings (last) 3535 "Add text properties to headings from point to LAST." 3536 (when (markdown-match-propertized-text 'markdown-heading last) 3537 (let* ((level (markdown-outline-level)) 3538 (heading-face 3539 (intern (format "markdown-header-face-%d" level))) 3540 (heading-props `(face ,heading-face)) 3541 (left-markup-props 3542 `(face markdown-header-delimiter-face 3543 ,@(cond 3544 (markdown-hide-markup 3545 `(display "")) 3546 (markdown-marginalize-headers 3547 `(display ((margin left-margin) 3548 ,(markdown--marginalize-string level))))))) 3549 (right-markup-props 3550 `(face markdown-header-delimiter-face 3551 ,@(when markdown-hide-markup `(display "")))) 3552 (rule-props `(face markdown-header-rule-face 3553 ,@(when markdown-hide-markup `(display ""))))) 3554 (if (match-end 1) 3555 ;; Setext heading 3556 (progn (add-text-properties 3557 (match-beginning 1) (match-end 1) heading-props) 3558 (if (= level 1) 3559 (add-text-properties 3560 (match-beginning 2) (match-end 2) rule-props) 3561 (add-text-properties 3562 (match-beginning 3) (match-end 3) rule-props))) 3563 ;; atx heading 3564 (let ((fontified-start 3565 (if (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) 3566 (match-beginning 5) 3567 (match-beginning 0))) 3568 (fontified-end 3569 (if markdown-fontify-whole-heading-line 3570 (min (point-max) (1+ (match-end 0))) 3571 (match-end 5)))) 3572 (add-text-properties 3573 (match-beginning 4) (match-end 4) left-markup-props) 3574 3575 ;; If closing tag is present 3576 (if (match-end 6) 3577 (progn 3578 (add-text-properties fontified-start fontified-end heading-props) 3579 (when (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) 3580 (add-text-properties (match-beginning 6) (match-end 6) right-markup-props))) 3581 ;; If closing tag is not present 3582 (add-text-properties fontified-start fontified-end heading-props))))) 3583 t)) 3584 3585 (defun markdown-fontify-tables (last) 3586 (when (re-search-forward "|" last t) 3587 (when (markdown-table-at-point-p) 3588 (font-lock-append-text-property 3589 (line-beginning-position) (min (1+ (line-end-position)) (point-max)) 3590 'face 'markdown-table-face)) 3591 (forward-line 1) 3592 t)) 3593 3594 (defun markdown-fontify-blockquotes (last) 3595 "Apply font-lock properties to blockquotes from point to LAST." 3596 (when (markdown-match-blockquotes last) 3597 (let ((display-string 3598 (markdown--first-displayable markdown-blockquote-display-char))) 3599 (add-text-properties 3600 (match-beginning 1) (match-end 1) 3601 (if markdown-hide-markup 3602 `(face markdown-blockquote-face display ,display-string) 3603 `(face markdown-markup-face))) 3604 (font-lock-append-text-property 3605 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) 3606 t))) 3607 3608 (defun markdown-fontify-list-items (last) 3609 "Apply font-lock properties to list markers from point to LAST." 3610 (when (markdown-match-list-items last) 3611 (when (not (markdown-code-block-at-point-p (match-beginning 2))) 3612 (let* ((indent (length (match-string-no-properties 1))) 3613 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... 3614 (bullet (nth (mod level (length markdown-list-item-bullets)) 3615 markdown-list-item-bullets))) 3616 (add-text-properties 3617 (match-beginning 2) (match-end 2) '(face markdown-list-face)) 3618 (when markdown-hide-markup 3619 (cond 3620 ;; Unordered lists 3621 ((string-match-p "[\\*\\+-]" (match-string 2)) 3622 (add-text-properties 3623 (match-beginning 2) (match-end 2) `(display ,bullet))) 3624 ;; Definition lists 3625 ((string-equal ":" (match-string 2)) 3626 (let ((display-string 3627 (char-to-string (markdown--first-displayable 3628 markdown-definition-display-char)))) 3629 (add-text-properties (match-beginning 2) (match-end 2) 3630 `(display ,display-string)))))))) 3631 t)) 3632 3633 (defun markdown--fontify-hrs-view-mode (hr-char) 3634 (if (and hr-char (display-supports-face-attributes-p '(:extend t))) 3635 (add-text-properties 3636 (match-beginning 0) (match-end 0) 3637 `(face 3638 (:inherit markdown-hr-face :underline t :extend t) 3639 font-lock-multiline t 3640 display "\n")) 3641 (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) 3642 (add-text-properties 3643 (match-beginning 0) (match-end 0) 3644 `(face 3645 markdown-hr-face font-lock-multiline t 3646 display ,(make-string hr-len hr-char)))))) 3647 3648 (defun markdown-fontify-hrs (last) 3649 "Add text properties to horizontal rules from point to LAST." 3650 (when (markdown-match-hr last) 3651 (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) 3652 (if (and markdown-hide-markup hr-char) 3653 (markdown--fontify-hrs-view-mode hr-char) 3654 (add-text-properties 3655 (match-beginning 0) (match-end 0) 3656 `(face markdown-hr-face font-lock-multiline t))) 3657 t))) 3658 3659 (defun markdown-fontify-sub-superscripts (last) 3660 "Apply text properties to sub- and superscripts from point to LAST." 3661 (when (markdown-search-until-condition 3662 (lambda () (and (not (markdown-code-block-at-point-p)) 3663 (not (markdown-inline-code-at-point-p)) 3664 (not (markdown-in-comment-p)) 3665 (not (markdown--math-block-p)))) 3666 markdown-regex-sub-superscript last t) 3667 (let* ((subscript-p (string= (match-string 2) "~")) 3668 (props 3669 (if subscript-p 3670 (car markdown-sub-superscript-display) 3671 (cdr markdown-sub-superscript-display))) 3672 (mp (list 'face 'markdown-markup-face 3673 'invisible 'markdown-markup))) 3674 (when markdown-hide-markup 3675 (put-text-property (match-beginning 3) (match-end 3) 3676 'display props)) 3677 (add-text-properties (match-beginning 2) (match-end 2) mp) 3678 (add-text-properties (match-beginning 4) (match-end 4) mp) 3679 t))) 3680 3681 3682 ;;; Syntax Table ============================================================== 3683 3684 (defvar markdown-mode-syntax-table 3685 (let ((tab (make-syntax-table text-mode-syntax-table))) 3686 (modify-syntax-entry ?\" "." tab) 3687 tab) 3688 "Syntax table for `markdown-mode'.") 3689 3690 3691 ;;; Element Insertion ========================================================= 3692 3693 (defun markdown-ensure-blank-line-before () 3694 "If previous line is not already blank, insert a blank line before point." 3695 (unless (bolp) (insert "\n")) 3696 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) 3697 3698 (defun markdown-ensure-blank-line-after () 3699 "If following line is not already blank, insert a blank line after point. 3700 Return the point where it was originally." 3701 (save-excursion 3702 (unless (eolp) (insert "\n")) 3703 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) 3704 3705 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) 3706 "Insert the strings S1 and S2, wrapping around region or THING. 3707 If a region is specified by the optional BEG and END arguments, 3708 wrap the strings S1 and S2 around that region. 3709 If there is an active region, wrap the strings S1 and S2 around 3710 the region. If there is not an active region but the point is at 3711 THING, wrap that thing (which defaults to word). Otherwise, just 3712 insert S1 and S2 and place the point in between. Return the 3713 bounds of the entire wrapped string, or nil if nothing was wrapped 3714 and S1 and S2 were only inserted." 3715 (let (a b bounds new-point) 3716 (cond 3717 ;; Given region 3718 ((and beg end) 3719 (setq a beg 3720 b end 3721 new-point (+ (point) (length s1)))) 3722 ;; Active region 3723 ((use-region-p) 3724 (setq a (region-beginning) 3725 b (region-end) 3726 new-point (+ (point) (length s1)))) 3727 ;; Thing (word) at point 3728 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) 3729 (setq a (car bounds) 3730 b (cdr bounds) 3731 new-point (+ (point) (length s1)))) 3732 ;; No active region and no word 3733 (t 3734 (setq a (point) 3735 b (point)))) 3736 (goto-char b) 3737 (insert s2) 3738 (goto-char a) 3739 (insert s1) 3740 (when new-point (goto-char new-point)) 3741 (if (= a b) 3742 nil 3743 (setq b (+ b (length s1) (length s2))) 3744 (cons a b)))) 3745 3746 (defun markdown-point-after-unwrap (cur prefix suffix) 3747 "Return desired position of point after an unwrapping operation. 3748 CUR gives the position of the point before the operation. 3749 Additionally, two cons cells must be provided. PREFIX gives the 3750 bounds of the prefix string and SUFFIX gives the bounds of the 3751 suffix string." 3752 (cond ((< cur (cdr prefix)) (car prefix)) 3753 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) 3754 ((<= cur (cdr suffix)) 3755 (- cur (+ (- (cdr prefix) (car prefix)) 3756 (- cur (car suffix))))) 3757 (t cur))) 3758 3759 (defun markdown-unwrap-thing-at-point (regexp all text) 3760 "Remove prefix and suffix of thing at point and reposition the point. 3761 When the thing at point matches REGEXP, replace the subexpression 3762 ALL with the string in subexpression TEXT. Reposition the point 3763 in an appropriate location accounting for the removal of prefix 3764 and suffix strings. Return new bounds of string from group TEXT. 3765 When REGEXP is nil, assumes match data is already set." 3766 (when (or (null regexp) 3767 (thing-at-point-looking-at regexp)) 3768 (let ((cur (point)) 3769 (prefix (cons (match-beginning all) (match-beginning text))) 3770 (suffix (cons (match-end text) (match-end all))) 3771 (bounds (cons (match-beginning text) (match-end text)))) 3772 ;; Replace the thing at point 3773 (replace-match (match-string text) t t nil all) 3774 ;; Reposition the point 3775 (goto-char (markdown-point-after-unwrap cur prefix suffix)) 3776 ;; Adjust bounds 3777 (setq bounds (cons (car prefix) 3778 (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) 3779 3780 (defun markdown-unwrap-things-in-region (beg end regexp all text) 3781 "Remove prefix and suffix of all things in region from BEG to END. 3782 When a thing in the region matches REGEXP, replace the 3783 subexpression ALL with the string in subexpression TEXT. 3784 Return a cons cell containing updated bounds for the region." 3785 (save-excursion 3786 (goto-char beg) 3787 (let ((removed 0) len-all len-text) 3788 (while (re-search-forward regexp (- end removed) t) 3789 (setq len-all (length (match-string-no-properties all))) 3790 (setq len-text (length (match-string-no-properties text))) 3791 (setq removed (+ removed (- len-all len-text))) 3792 (replace-match (match-string text) t t nil all)) 3793 (cons beg (- end removed))))) 3794 3795 (defun markdown-insert-hr (arg) 3796 "Insert or replace a horizontal rule. 3797 By default, use the first element of `markdown-hr-strings'. When 3798 ARG is non-nil, as when given a prefix, select a different 3799 element as follows. When prefixed with \\[universal-argument], 3800 use the last element of `markdown-hr-strings' instead. When 3801 prefixed with an integer from 1 to the length of 3802 `markdown-hr-strings', use the element in that position instead." 3803 (interactive "*P") 3804 (when (thing-at-point-looking-at markdown-regex-hr) 3805 (delete-region (match-beginning 0) (match-end 0))) 3806 (markdown-ensure-blank-line-before) 3807 (cond ((equal arg '(4)) 3808 (insert (car (reverse markdown-hr-strings)))) 3809 ((and (integerp arg) (> arg 0) 3810 (<= arg (length markdown-hr-strings))) 3811 (insert (nth (1- arg) markdown-hr-strings))) 3812 (t 3813 (insert (car markdown-hr-strings)))) 3814 (markdown-ensure-blank-line-after)) 3815 3816 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face 3817 &optional skip-space) 3818 (if (use-region-p) 3819 ;; Active region 3820 (let* ((bounds (markdown-unwrap-things-in-region 3821 (region-beginning) (region-end) 3822 regex start-group end-group)) 3823 (beg (car bounds)) 3824 (end (cdr bounds))) 3825 (when (and beg skip-space) 3826 (save-excursion 3827 (goto-char beg) 3828 (skip-chars-forward " \t") 3829 (setq beg (point)))) 3830 (when (and end skip-space) 3831 (save-excursion 3832 (goto-char end) 3833 (skip-chars-backward " \t") 3834 (setq end (point)))) 3835 (markdown-wrap-or-insert start-delim end-delim nil beg end)) 3836 (if (markdown--face-p (point) (list face)) 3837 (save-excursion 3838 (while (and (markdown--face-p (point) (list face)) (not (bobp))) 3839 (forward-char -1)) 3840 (forward-char (- (1- (length start-delim)))) ;; for delimiter 3841 (unless (bolp) 3842 (forward-char -1)) 3843 (when (looking-at regex) 3844 (markdown-unwrap-thing-at-point nil start-group end-group))) 3845 (if (thing-at-point-looking-at regex) 3846 (markdown-unwrap-thing-at-point nil start-group end-group) 3847 (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) 3848 3849 (defun markdown-insert-bold () 3850 "Insert markup to make a region or word bold. 3851 If there is an active region, make the region bold. If the point 3852 is at a non-bold word, make the word bold. If the point is at a 3853 bold word or phrase, remove the bold markup. Otherwise, simply 3854 insert bold delimiters and place the point in between them." 3855 (interactive) 3856 (let ((delim (if markdown-bold-underscore "__" "**"))) 3857 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) 3858 3859 (defun markdown-insert-italic () 3860 "Insert markup to make a region or word italic. 3861 If there is an active region, make the region italic. If the point 3862 is at a non-italic word, make the word italic. If the point is at an 3863 italic word or phrase, remove the italic markup. Otherwise, simply 3864 insert italic delimiters and place the point in between them." 3865 (interactive) 3866 (let ((delim (if markdown-italic-underscore "_" "*"))) 3867 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) 3868 3869 (defun markdown-insert-strike-through () 3870 "Insert markup to make a region or word strikethrough. 3871 If there is an active region, make the region strikethrough. If the point 3872 is at a non-bold word, make the word strikethrough. If the point is at a 3873 strikethrough word or phrase, remove the strikethrough markup. Otherwise, 3874 simply insert bold delimiters and place the point in between them." 3875 (interactive) 3876 (markdown--insert-common 3877 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) 3878 3879 (defun markdown-insert-code () 3880 "Insert markup to make a region or word an inline code fragment. 3881 If there is an active region, make the region an inline code 3882 fragment. If the point is at a word, make the word an inline 3883 code fragment. Otherwise, simply insert code delimiters and 3884 place the point in between them." 3885 (interactive) 3886 (if (use-region-p) 3887 ;; Active region 3888 (let ((bounds (markdown-unwrap-things-in-region 3889 (region-beginning) (region-end) 3890 markdown-regex-code 1 3))) 3891 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) 3892 ;; Code markup removal, code markup for word, or empty markup insertion 3893 (if (markdown-inline-code-at-point) 3894 (markdown-unwrap-thing-at-point nil 0 2) 3895 (markdown-wrap-or-insert "`" "`" 'word nil nil)))) 3896 3897 (defun markdown-insert-kbd () 3898 "Insert markup to wrap region or word in <kbd> tags. 3899 If there is an active region, use the region. If the point is at 3900 a word, use the word. Otherwise, simply insert <kbd> tags and 3901 place the point in between them." 3902 (interactive) 3903 (if (use-region-p) 3904 ;; Active region 3905 (let ((bounds (markdown-unwrap-things-in-region 3906 (region-beginning) (region-end) 3907 markdown-regex-kbd 0 2))) 3908 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) 3909 ;; Markup removal, markup for word, or empty markup insertion 3910 (if (thing-at-point-looking-at markdown-regex-kbd) 3911 (markdown-unwrap-thing-at-point nil 0 2) 3912 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) 3913 3914 (defun markdown-insert-inline-link (text url &optional title) 3915 "Insert an inline link with TEXT pointing to URL. 3916 Optionally, the user can provide a TITLE." 3917 (let ((cur (point))) 3918 (setq title (and title (concat " \"" title "\""))) 3919 (insert (concat "[" text "](" url title ")")) 3920 (cond ((not text) (goto-char (+ 1 cur))) 3921 ((not url) (goto-char (+ 3 (length text) cur)))))) 3922 3923 (defun markdown-insert-inline-image (text url &optional title) 3924 "Insert an inline link with alt TEXT pointing to URL. 3925 Optionally, also provide a TITLE." 3926 (let ((cur (point))) 3927 (setq title (and title (concat " \"" title "\""))) 3928 (insert (concat "![" text "](" url title ")")) 3929 (cond ((not text) (goto-char (+ 2 cur))) 3930 ((not url) (goto-char (+ 4 (length text) cur)))))) 3931 3932 (defun markdown-insert-reference-link (text label &optional url title) 3933 "Insert a reference link and, optionally, a reference definition. 3934 The link TEXT will be inserted followed by the optional LABEL. 3935 If a URL is given, also insert a definition for the reference 3936 LABEL according to `markdown-reference-location'. If a TITLE is 3937 given, it will be added to the end of the reference definition 3938 and will be used to populate the title attribute when converted 3939 to XHTML. If URL is nil, insert only the link portion (for 3940 example, when a reference label is already defined)." 3941 (insert (concat "[" text "][" label "]")) 3942 (when url 3943 (markdown-insert-reference-definition 3944 (if (string-equal label "") text label) 3945 url title))) 3946 3947 (defun markdown-insert-reference-image (text label &optional url title) 3948 "Insert a reference image and, optionally, a reference definition. 3949 The alt TEXT will be inserted followed by the optional LABEL. 3950 If a URL is given, also insert a definition for the reference 3951 LABEL according to `markdown-reference-location'. If a TITLE is 3952 given, it will be added to the end of the reference definition 3953 and will be used to populate the title attribute when converted 3954 to XHTML. If URL is nil, insert only the link portion (for 3955 example, when a reference label is already defined)." 3956 (insert (concat "![" text "][" label "]")) 3957 (when url 3958 (markdown-insert-reference-definition 3959 (if (string-equal label "") text label) 3960 url title))) 3961 3962 (defun markdown-insert-reference-definition (label &optional url title) 3963 "Add definition for reference LABEL with URL and TITLE. 3964 LABEL is a Markdown reference label without square brackets. 3965 URL and TITLE are optional. When given, the TITLE will 3966 be used to populate the title attribute when converted to XHTML." 3967 ;; END specifies where to leave the point upon return 3968 (let ((end (point))) 3969 (cl-case markdown-reference-location 3970 (end (goto-char (point-max))) 3971 (immediately (markdown-end-of-text-block)) 3972 (subtree (markdown-end-of-subtree)) 3973 (header (markdown-end-of-defun))) 3974 ;; Skip backwards over local variables. This logic is similar to the one 3975 ;; used in ‘hack-local-variables’. 3976 (when (and enable-local-variables (eobp)) 3977 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) 3978 (when (let ((case-fold-search t)) 3979 (search-forward "Local Variables:" nil :move)) 3980 (beginning-of-line 0) 3981 (when (eq (char-before) ?\n) (backward-char)))) 3982 (unless (or (markdown-cur-line-blank-p) 3983 (thing-at-point-looking-at markdown-regex-reference-definition)) 3984 (insert "\n")) 3985 (insert "\n[" label "]: ") 3986 (if url 3987 (insert url) 3988 ;; When no URL is given, leave point at END following the colon 3989 (setq end (point))) 3990 (when (> (length title) 0) 3991 (insert " \"" title "\"")) 3992 (unless (looking-at-p "\n") 3993 (insert "\n")) 3994 (goto-char end) 3995 (when url 3996 (message 3997 (markdown--substitute-command-keys 3998 "Reference [%s] was defined, press \\[markdown-do] to jump there") 3999 label)))) 4000 4001 (defcustom markdown-link-make-text-function nil 4002 "Function that automatically generates a link text for a URL. 4003 4004 If non-nil, this function will be called by 4005 `markdown--insert-link-or-image' and the result will be the 4006 default link text. The function should receive exactly one 4007 argument that corresponds to the link URL." 4008 :group 'markdown 4009 :type 'function 4010 :package-version '(markdown-mode . "2.5")) 4011 4012 (defcustom markdown-disable-tooltip-prompt nil 4013 "Disable prompt for tooltip when inserting a link or image. 4014 4015 If non-nil, `markdown-insert-link' and `markdown-insert-link' 4016 will not prompt the user to insert a tooltip text for the given 4017 link or image." 4018 :group 'markdown 4019 :type 'boolean 4020 :safe 'booleanp 4021 :package-version '(markdown-mode . "2.5")) 4022 4023 (defun markdown--insert-link-or-image (image) 4024 "Interactively insert new or update an existing link or image. 4025 When IMAGE is non-nil, insert an image. Otherwise, insert a link. 4026 This is an internal function called by 4027 `markdown-insert-link' and `markdown-insert-image'." 4028 (cl-multiple-value-bind (begin end text uri ref title) 4029 (if (use-region-p) 4030 ;; Use region as either link text or URL as appropriate. 4031 (let ((region (buffer-substring-no-properties 4032 (region-beginning) (region-end)))) 4033 (if (string-match markdown-regex-uri region) 4034 ;; Region contains a URL; use it as such. 4035 (list (region-beginning) (region-end) 4036 nil (match-string 0 region) nil nil) 4037 ;; Region doesn't contain a URL, so use it as text. 4038 (list (region-beginning) (region-end) 4039 region nil nil nil))) 4040 ;; Extract and use properties of existing link, if any. 4041 (markdown-link-at-pos (point))) 4042 (let* ((ref (when ref (concat "[" ref "]"))) 4043 (defined-refs (mapcar #'car (markdown-get-defined-references))) 4044 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) 4045 (used-uris (markdown-get-used-uris)) 4046 (uri-or-ref (completing-read 4047 "URL or [reference]: " 4048 (append defined-ref-cands used-uris) 4049 nil nil (or uri ref))) 4050 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) 4051 (match-string 1 uri-or-ref)) 4052 ((string-equal "" uri-or-ref) 4053 ""))) 4054 (uri (unless ref uri-or-ref)) 4055 (text-prompt (if image 4056 "Alt text: " 4057 (if ref 4058 "Link text: " 4059 "Link text (blank for plain URL): "))) 4060 (text (or text (and markdown-link-make-text-function uri 4061 (funcall markdown-link-make-text-function uri)))) 4062 (text (completing-read text-prompt defined-refs nil nil text)) 4063 (text (if (= (length text) 0) nil text)) 4064 (plainp (and uri (not text))) 4065 (implicitp (string-equal ref "")) 4066 (ref (if implicitp text ref)) 4067 (definedp (and ref (markdown-reference-definition ref))) 4068 (ref-url (unless (or uri definedp) 4069 (completing-read "Reference URL: " used-uris))) 4070 (title (unless (or plainp definedp markdown-disable-tooltip-prompt) 4071 (read-string "Title (tooltip text, optional): " title))) 4072 (title (if (= (length title) 0) nil title))) 4073 (when (and image implicitp) 4074 (user-error "Reference required: implicit image references are invalid")) 4075 (when (and begin end) 4076 (delete-region begin end)) 4077 (cond 4078 ((and (not image) uri text) 4079 (markdown-insert-inline-link text uri title)) 4080 ((and image uri text) 4081 (markdown-insert-inline-image text uri title)) 4082 ((and ref text) 4083 (if image 4084 (markdown-insert-reference-image text (unless implicitp ref) nil title) 4085 (markdown-insert-reference-link text (unless implicitp ref) nil title)) 4086 (unless definedp 4087 (markdown-insert-reference-definition ref ref-url title))) 4088 ((and (not image) uri) 4089 (markdown-insert-uri uri)))))) 4090 4091 (defun markdown-insert-link () 4092 "Insert new or update an existing link, with interactive prompt. 4093 If the point is at an existing link or URL, update the link text, 4094 URL, reference label, and/or title. Otherwise, insert a new link. 4095 The type of link inserted (inline, reference, or plain URL) 4096 depends on which values are provided: 4097 4098 * If a URL and TEXT are given, insert an inline link: [TEXT](URL). 4099 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. 4100 * If only TEXT is given, insert an implicit reference link: [TEXT][]. 4101 * If only a URL is given, insert a plain link: <URL>. 4102 4103 In other words, to create an implicit reference link, leave the 4104 URL prompt empty and to create a plain URL link, leave the link 4105 text empty. 4106 4107 If there is an active region, use the text as the default URL, if 4108 it seems to be a URL, or link text value otherwise. 4109 4110 If a given reference is not defined, this function will 4111 additionally prompt for the URL and optional title. In this case, 4112 the reference definition is placed at the location determined by 4113 `markdown-reference-location'. In addition, it is possible to 4114 have the `markdown-link-make-text-function' function, if non-nil, 4115 define the default link text before prompting the user for it. 4116 4117 If `markdown-disable-tooltip-prompt' is non-nil, the user will 4118 not be prompted to add or modify a tooltip text. 4119 4120 Through updating the link, this function can be used to convert a 4121 link of one type (inline, reference, or plain) to another type by 4122 selectively adding or removing information via the prompts." 4123 (interactive) 4124 (markdown--insert-link-or-image nil)) 4125 4126 (defun markdown-insert-image () 4127 "Insert new or update an existing image, with interactive prompt. 4128 If the point is at an existing image, update the alt text, URL, 4129 reference label, and/or title. Otherwise, insert a new image. 4130 The type of image inserted (inline or reference) depends on which 4131 values are provided: 4132 4133 * If a URL and ALT-TEXT are given, insert an inline image: 4134 ![ALT-TEXT](URL). 4135 * If [REF] and ALT-TEXT are given, insert a reference image: 4136 ![ALT-TEXT][REF]. 4137 4138 If there is an active region, use the text as the default URL, if 4139 it seems to be a URL, or alt text value otherwise. 4140 4141 If a given reference is not defined, this function will 4142 additionally prompt for the URL and optional title. In this case, 4143 the reference definition is placed at the location determined by 4144 `markdown-reference-location'. 4145 4146 Through updating the image, this function can be used to convert an 4147 image of one type (inline or reference) to another type by 4148 selectively adding or removing information via the prompts." 4149 (interactive) 4150 (markdown--insert-link-or-image t)) 4151 4152 (defun markdown-insert-uri (&optional uri) 4153 "Insert markup for an inline URI. 4154 If there is an active region, use it as the URI. If the point is 4155 at a URI, wrap it with angle brackets. If the point is at an 4156 inline URI, remove the angle brackets. Otherwise, simply insert 4157 angle brackets place the point between them." 4158 (interactive) 4159 (if (use-region-p) 4160 ;; Active region 4161 (let ((bounds (markdown-unwrap-things-in-region 4162 (region-beginning) (region-end) 4163 markdown-regex-angle-uri 0 2))) 4164 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) 4165 ;; Markup removal, URI at point, new URI, or empty markup insertion 4166 (if (thing-at-point-looking-at markdown-regex-angle-uri) 4167 (markdown-unwrap-thing-at-point nil 0 2) 4168 (if uri 4169 (insert "<" uri ">") 4170 (markdown-wrap-or-insert "<" ">" 'url nil nil))))) 4171 4172 (defun markdown-insert-wiki-link () 4173 "Insert a wiki link of the form [[WikiLink]]. 4174 If there is an active region, use the region as the link text. 4175 If the point is at a word, use the word as the link text. If 4176 there is no active region and the point is not at word, simply 4177 insert link markup." 4178 (interactive) 4179 (if (use-region-p) 4180 ;; Active region 4181 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) 4182 ;; Markup removal, wiki link at at point, or empty markup insertion 4183 (if (thing-at-point-looking-at markdown-regex-wiki-link) 4184 (if (or markdown-wiki-link-alias-first 4185 (null (match-string 5))) 4186 (markdown-unwrap-thing-at-point nil 1 3) 4187 (markdown-unwrap-thing-at-point nil 1 5)) 4188 (markdown-wrap-or-insert "[[" "]]")))) 4189 4190 (defun markdown-remove-header () 4191 "Remove header markup if point is at a header. 4192 Return bounds of remaining header text if a header was removed 4193 and nil otherwise." 4194 (interactive "*") 4195 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) 4196 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) 4197 4198 (defun markdown-insert-header (&optional level text setext) 4199 "Insert or replace header markup. 4200 The level of the header is specified by LEVEL and header text is 4201 given by TEXT. LEVEL must be an integer from 1 and 6, and the 4202 default value is 1. 4203 When TEXT is nil, the header text is obtained as follows. 4204 If there is an active region, it is used as the header text. 4205 Otherwise, the current line will be used as the header text. 4206 If there is not an active region and the point is at a header, 4207 remove the header markup and replace with level N header. 4208 Otherwise, insert empty header markup and place the point in 4209 between. 4210 The style of the header will be atx (hash marks) unless 4211 SETEXT is non-nil, in which case a setext-style (underlined) 4212 header will be inserted." 4213 (interactive "p\nsHeader text: ") 4214 (setq level (min (max (or level 1) 1) (if setext 2 6))) 4215 ;; Determine header text if not given 4216 (when (null text) 4217 (if (use-region-p) 4218 ;; Active region 4219 (setq text (delete-and-extract-region (region-beginning) (region-end))) 4220 ;; No active region 4221 (markdown-remove-header) 4222 (setq text (delete-and-extract-region 4223 (line-beginning-position) (line-end-position))) 4224 (when (and setext (string-match-p "^[ \t]*$" text)) 4225 (setq text (read-string "Header text: ")))) 4226 (setq text (markdown-compress-whitespace-string text))) 4227 ;; Insertion with given text 4228 (markdown-ensure-blank-line-before) 4229 (let (hdr) 4230 (cond (setext 4231 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) 4232 (insert text "\n" hdr)) 4233 (t 4234 (setq hdr (make-string level ?#)) 4235 (insert hdr " " text) 4236 (when (null markdown-asymmetric-header) (insert " " hdr))))) 4237 (markdown-ensure-blank-line-after) 4238 ;; Leave point at end of text 4239 (cond (setext 4240 (backward-char (1+ (string-width text)))) 4241 ((null markdown-asymmetric-header) 4242 (backward-char (1+ level))))) 4243 4244 (defun markdown-insert-header-dwim (&optional arg setext) 4245 "Insert or replace header markup. 4246 The level and type of the header are determined automatically by 4247 the type and level of the previous header, unless a prefix 4248 argument is given via ARG. 4249 With a numeric prefix valued 1 to 6, insert a header of the given 4250 level, with the type being determined automatically (note that 4251 only level 1 or 2 setext headers are possible). 4252 4253 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 4254 promote the heading by one level. 4255 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 4256 demote the heading by one level. 4257 When SETEXT is non-nil, prefer setext-style headers when 4258 possible (levels one and two). 4259 4260 When there is an active region, use it for the header text. When 4261 the point is at an existing header, change the type and level 4262 according to the rules above. 4263 Otherwise, if the line is not empty, create a header using the 4264 text on the current line as the header text. 4265 Finally, if the point is on a blank line, insert empty header 4266 markup (atx) or prompt for text (setext). 4267 See `markdown-insert-header' for more details about how the 4268 header text is determined." 4269 (interactive "*P") 4270 (let (level) 4271 (save-excursion 4272 (when (or (thing-at-point-looking-at markdown-regex-header) 4273 (re-search-backward markdown-regex-header nil t)) 4274 ;; level of current or previous header 4275 (setq level (markdown-outline-level)) 4276 ;; match group 1 indicates a setext header 4277 (setq setext (match-end 1)))) 4278 ;; check prefix argument 4279 (cond 4280 ((and (equal arg '(4)) level (> level 1)) ;; C-u 4281 (cl-decf level)) 4282 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u 4283 (cl-incf level)) 4284 (arg ;; numeric prefix 4285 (setq level (prefix-numeric-value arg)))) 4286 ;; setext headers must be level one or two 4287 (and level (setq setext (and setext (<= level 2)))) 4288 ;; insert the heading 4289 (markdown-insert-header level nil setext))) 4290 4291 (defun markdown-insert-header-setext-dwim (&optional arg) 4292 "Insert or replace header markup, with preference for setext. 4293 See `markdown-insert-header-dwim' for details, including how ARG is handled." 4294 (interactive "*P") 4295 (markdown-insert-header-dwim arg t)) 4296 4297 (defun markdown-insert-header-atx-1 () 4298 "Insert a first level atx-style (hash mark) header. 4299 See `markdown-insert-header'." 4300 (interactive "*") 4301 (markdown-insert-header 1 nil nil)) 4302 4303 (defun markdown-insert-header-atx-2 () 4304 "Insert a level two atx-style (hash mark) header. 4305 See `markdown-insert-header'." 4306 (interactive "*") 4307 (markdown-insert-header 2 nil nil)) 4308 4309 (defun markdown-insert-header-atx-3 () 4310 "Insert a level three atx-style (hash mark) header. 4311 See `markdown-insert-header'." 4312 (interactive "*") 4313 (markdown-insert-header 3 nil nil)) 4314 4315 (defun markdown-insert-header-atx-4 () 4316 "Insert a level four atx-style (hash mark) header. 4317 See `markdown-insert-header'." 4318 (interactive "*") 4319 (markdown-insert-header 4 nil nil)) 4320 4321 (defun markdown-insert-header-atx-5 () 4322 "Insert a level five atx-style (hash mark) header. 4323 See `markdown-insert-header'." 4324 (interactive "*") 4325 (markdown-insert-header 5 nil nil)) 4326 4327 (defun markdown-insert-header-atx-6 () 4328 "Insert a sixth level atx-style (hash mark) header. 4329 See `markdown-insert-header'." 4330 (interactive "*") 4331 (markdown-insert-header 6 nil nil)) 4332 4333 (defun markdown-insert-header-setext-1 () 4334 "Insert a setext-style (underlined) first-level header. 4335 See `markdown-insert-header'." 4336 (interactive "*") 4337 (markdown-insert-header 1 nil t)) 4338 4339 (defun markdown-insert-header-setext-2 () 4340 "Insert a setext-style (underlined) second-level header. 4341 See `markdown-insert-header'." 4342 (interactive "*") 4343 (markdown-insert-header 2 nil t)) 4344 4345 (defun markdown-blockquote-indentation (loc) 4346 "Return string containing necessary indentation for a blockquote at LOC. 4347 Also see `markdown-pre-indentation'." 4348 (save-excursion 4349 (goto-char loc) 4350 (let* ((list-level (length (markdown-calculate-list-levels))) 4351 (indent "")) 4352 (dotimes (_ list-level indent) 4353 (setq indent (concat indent " ")))))) 4354 4355 (defun markdown-insert-blockquote () 4356 "Start a blockquote section (or blockquote the region). 4357 If Transient Mark mode is on and a region is active, it is used as 4358 the blockquote text." 4359 (interactive) 4360 (if (use-region-p) 4361 (markdown-blockquote-region (region-beginning) (region-end)) 4362 (markdown-ensure-blank-line-before) 4363 (insert (markdown-blockquote-indentation (point)) "> ") 4364 (markdown-ensure-blank-line-after))) 4365 4366 (defun markdown-block-region (beg end prefix) 4367 "Format the region using a block prefix. 4368 Arguments BEG and END specify the beginning and end of the 4369 region. The characters PREFIX will appear at the beginning 4370 of each line." 4371 (save-excursion 4372 (let* ((end-marker (make-marker)) 4373 (beg-marker (make-marker)) 4374 (prefix-without-trailing-whitespace 4375 (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) 4376 ;; Ensure blank line after and remove extra whitespace 4377 (goto-char end) 4378 (skip-syntax-backward "-") 4379 (set-marker end-marker (point)) 4380 (delete-horizontal-space) 4381 (markdown-ensure-blank-line-after) 4382 ;; Ensure blank line before and remove extra whitespace 4383 (goto-char beg) 4384 (skip-syntax-forward "-") 4385 (delete-horizontal-space) 4386 (markdown-ensure-blank-line-before) 4387 (set-marker beg-marker (point)) 4388 ;; Insert PREFIX before each line 4389 (goto-char beg-marker) 4390 (while (and (< (line-beginning-position) end-marker) 4391 (not (eobp))) 4392 ;; Don’t insert trailing whitespace. 4393 (insert (if (eolp) prefix-without-trailing-whitespace prefix)) 4394 (forward-line))))) 4395 4396 (defun markdown-blockquote-region (beg end) 4397 "Blockquote the region. 4398 Arguments BEG and END specify the beginning and end of the region." 4399 (interactive "*r") 4400 (markdown-block-region 4401 beg end (concat (markdown-blockquote-indentation 4402 (max (point-min) (1- beg))) "> "))) 4403 4404 (defun markdown-pre-indentation (loc) 4405 "Return string containing necessary whitespace for a pre block at LOC. 4406 Also see `markdown-blockquote-indentation'." 4407 (save-excursion 4408 (goto-char loc) 4409 (let* ((list-level (length (markdown-calculate-list-levels))) 4410 indent) 4411 (dotimes (_ (1+ list-level) indent) 4412 (setq indent (concat indent " ")))))) 4413 4414 (defun markdown-insert-pre () 4415 "Start a preformatted section (or apply to the region). 4416 If Transient Mark mode is on and a region is active, it is marked 4417 as preformatted text." 4418 (interactive) 4419 (if (use-region-p) 4420 (markdown-pre-region (region-beginning) (region-end)) 4421 (markdown-ensure-blank-line-before) 4422 (insert (markdown-pre-indentation (point))) 4423 (markdown-ensure-blank-line-after))) 4424 4425 (defun markdown-pre-region (beg end) 4426 "Format the region as preformatted text. 4427 Arguments BEG and END specify the beginning and end of the region." 4428 (interactive "*r") 4429 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) 4430 (markdown-block-region beg end indent))) 4431 4432 (defun markdown-electric-backquote (arg) 4433 "Insert a backquote. 4434 The numeric prefix argument ARG says how many times to repeat the insertion. 4435 Call `markdown-insert-gfm-code-block' interactively 4436 if three backquotes inserted at the beginning of line." 4437 (interactive "*P") 4438 (self-insert-command (prefix-numeric-value arg)) 4439 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) 4440 (replace-match "") 4441 (call-interactively #'markdown-insert-gfm-code-block))) 4442 4443 (defconst markdown-gfm-recognized-languages 4444 ;; To reproduce/update, evaluate the let-form in 4445 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, 4446 ;; but with appropriate use of a keyboard macro, indenting and filling it 4447 ;; properly is pretty fast. 4448 '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" 4449 "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" 4450 "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" 4451 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" 4452 "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" 4453 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" 4454 "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" 4455 "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" 4456 "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" 4457 "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" 4458 "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" 4459 "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" 4460 "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" 4461 "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" 4462 "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" 4463 "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" 4464 "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" 4465 "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" 4466 "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" 4467 "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" 4468 "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" 4469 "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" 4470 "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" 4471 "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" 4472 "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" 4473 "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" 4474 "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" 4475 "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" 4476 "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" 4477 "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" 4478 "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" 4479 "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" 4480 "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" 4481 "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" 4482 "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" 4483 "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" 4484 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" 4485 "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" 4486 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" 4487 "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" 4488 "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" 4489 "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" 4490 "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" 4491 "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" 4492 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" 4493 "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" 4494 "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" 4495 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" 4496 "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" 4497 "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" 4498 "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" 4499 "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" 4500 "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" 4501 "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" 4502 "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" 4503 "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" 4504 "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" 4505 "Linux-Kernel-Module" "Liquid" "Literate-Agda" 4506 "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" 4507 "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" 4508 "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" 4509 "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" 4510 "Max" "Mercury" "Mermaid" "Meson" "Metal" 4511 "Microsoft-Developer-Studio-Project" 4512 "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" 4513 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" 4514 "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" 4515 "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" 4516 "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" 4517 "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" 4518 "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" 4519 "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" 4520 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" 4521 "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" 4522 "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" 4523 "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" 4524 "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" 4525 "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" 4526 "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" 4527 "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" 4528 "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" 4529 "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" 4530 "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" 4531 "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" 4532 "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" 4533 "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" 4534 "PureBasic" "PureScript" "Pyret" "Python" "Python-console" 4535 "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" 4536 "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" 4537 "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" 4538 "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" 4539 "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" 4540 "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" 4541 "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" 4542 "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" 4543 "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" 4544 "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" 4545 "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" 4546 "ShellCheck-Config" "ShellSession" "Shen" "Sieve" 4547 "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" 4548 "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" 4549 "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" 4550 "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" 4551 "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" 4552 "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" 4553 "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" 4554 "Terraform-Template" "Texinfo" "Text" "TextGrid" 4555 "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" 4556 "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" 4557 "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" 4558 "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" 4559 "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" 4560 "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" 4561 "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" 4562 "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" 4563 "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" 4564 "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" 4565 "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" 4566 "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" 4567 "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" 4568 "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" 4569 "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" 4570 "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" 4571 "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" 4572 "reStructuredText" "robots.txt" "sed" "wisp" "xBase") 4573 "Language specifiers recognized by GitHub's syntax highlighting features.") 4574 4575 (defvar-local markdown-gfm-used-languages nil 4576 "Language names used in GFM code blocks.") 4577 4578 (defun markdown-trim-whitespace (str) 4579 (replace-regexp-in-string 4580 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) 4581 4582 (defun markdown-clean-language-string (str) 4583 (replace-regexp-in-string 4584 "{\\.?\\|}" "" (markdown-trim-whitespace str))) 4585 4586 (defun markdown-validate-language-string (widget) 4587 (let ((str (widget-value widget))) 4588 (unless (string= str (markdown-clean-language-string str)) 4589 (widget-put widget :error (format "Invalid language spec: '%s'" str)) 4590 widget))) 4591 4592 (defun markdown-gfm-get-corpus () 4593 "Create corpus of recognized GFM code block languages for the given buffer." 4594 (let ((given-corpus (append markdown-gfm-additional-languages 4595 markdown-gfm-recognized-languages))) 4596 (append 4597 markdown-gfm-used-languages 4598 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) 4599 given-corpus)))) 4600 4601 (defun markdown-gfm-add-used-language (lang) 4602 "Clean LANG and add to list of used languages." 4603 (setq markdown-gfm-used-languages 4604 (cons lang (remove lang markdown-gfm-used-languages)))) 4605 4606 (defcustom markdown-spaces-after-code-fence 1 4607 "Number of space characters to insert after a code fence. 4608 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an 4609 opening code fence and an info string." 4610 :group 'markdown 4611 :type 'integer 4612 :safe #'natnump 4613 :package-version '(markdown-mode . "2.3")) 4614 4615 (defcustom markdown-code-block-braces nil 4616 "When non-nil, automatically insert braces for GFM code blocks." 4617 :group 'markdown 4618 :type 'boolean) 4619 4620 (defun markdown-insert-gfm-code-block (&optional lang edit) 4621 "Insert GFM code block for language LANG. 4622 If LANG is nil, the language will be queried from user. If a 4623 region is active, wrap this region with the markup instead. If 4624 the region boundaries are not on empty lines, these are added 4625 automatically in order to have the correct markup. When EDIT is 4626 non-nil (e.g., when \\[universal-argument] is given), edit the 4627 code block in an indirect buffer after insertion." 4628 (interactive 4629 (list (let ((completion-ignore-case nil)) 4630 (condition-case nil 4631 (markdown-clean-language-string 4632 (completing-read 4633 "Programming language: " 4634 (markdown-gfm-get-corpus) 4635 nil 'confirm (car markdown-gfm-used-languages) 4636 'markdown-gfm-language-history)) 4637 (quit ""))) 4638 current-prefix-arg)) 4639 (unless (string= lang "") (markdown-gfm-add-used-language lang)) 4640 (when (and (> (length lang) 0) 4641 (not markdown-code-block-braces)) 4642 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) 4643 lang))) 4644 (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) 4645 (gfm-close-brace (if markdown-code-block-braces "}" ""))) 4646 (if (use-region-p) 4647 (let* ((b (region-beginning)) (e (region-end)) end 4648 (indent (progn (goto-char b) (current-indentation)))) 4649 (goto-char e) 4650 ;; if we're on a blank line, don't newline, otherwise the ``` 4651 ;; should go on its own line 4652 (unless (looking-back "\n" nil) 4653 (newline)) 4654 (indent-to indent) 4655 (insert "```") 4656 (markdown-ensure-blank-line-after) 4657 (setq end (point)) 4658 (goto-char b) 4659 ;; if we're on a blank line, insert the quotes here, otherwise 4660 ;; add a new line first 4661 (unless (looking-at-p "\n") 4662 (newline) 4663 (forward-line -1)) 4664 (markdown-ensure-blank-line-before) 4665 (indent-to indent) 4666 (insert "```" gfm-open-brace lang gfm-close-brace) 4667 (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) 4668 (let ((indent (current-indentation)) 4669 start-bol) 4670 (delete-horizontal-space :backward-only) 4671 (markdown-ensure-blank-line-before) 4672 (indent-to indent) 4673 (setq start-bol (line-beginning-position)) 4674 (insert "```" gfm-open-brace lang gfm-close-brace "\n") 4675 (indent-to indent) 4676 (unless edit (insert ?\n)) 4677 (indent-to indent) 4678 (insert "```") 4679 (markdown-ensure-blank-line-after) 4680 (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) 4681 (end-of-line 0) 4682 (when edit (markdown-edit-code-block))))) 4683 4684 (defun markdown-code-block-lang (&optional pos-prop) 4685 "Return the language name for a GFM or tilde fenced code block. 4686 The beginning of the block may be described by POS-PROP, 4687 a cons of (pos . prop) giving the position and property 4688 at the beginning of the block." 4689 (or pos-prop 4690 (setq pos-prop 4691 (markdown-max-of-seq 4692 #'car 4693 (cl-remove-if 4694 #'null 4695 (cl-mapcar 4696 #'markdown-find-previous-prop 4697 (markdown-get-fenced-block-begin-properties)))))) 4698 (when pos-prop 4699 (goto-char (car pos-prop)) 4700 (set-match-data (get-text-property (point) (cdr pos-prop))) 4701 ;; Note: Hard-coded group number assumes tilde 4702 ;; and GFM fenced code regexp groups agree. 4703 (let ((begin (match-beginning 3)) 4704 (end (match-end 3))) 4705 (when (and begin end) 4706 ;; Fix language strings beginning with periods, like ".ruby". 4707 (when (eq (char-after begin) ?.) 4708 (setq begin (1+ begin))) 4709 (buffer-substring-no-properties begin end))))) 4710 4711 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer) 4712 (with-current-buffer (or buffer (current-buffer)) 4713 (save-excursion 4714 (goto-char (point-min)) 4715 (cl-loop 4716 with prop = 'markdown-gfm-block-begin 4717 for pos-prop = (markdown-find-next-prop prop) 4718 while pos-prop 4719 for lang = (markdown-code-block-lang pos-prop) 4720 do (progn (when lang (markdown-gfm-add-used-language lang)) 4721 (goto-char (next-single-property-change (point) prop))))))) 4722 4723 (defun markdown-insert-foldable-block () 4724 "Insert details disclosure element to make content foldable. 4725 If a region is active, wrap this region with the disclosure 4726 element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." 4727 (interactive) 4728 (let ((details-open-tag "<details>") 4729 (details-close-tag "</details>") 4730 (summary-open-tag "<summary>") 4731 (summary-close-tag " </summary>")) 4732 (if (use-region-p) 4733 (let* ((b (region-beginning)) 4734 (e (region-end)) 4735 (indent (progn (goto-char b) (current-indentation)))) 4736 (goto-char e) 4737 ;; if we're on a blank line, don't newline, otherwise the tags 4738 ;; should go on its own line 4739 (unless (looking-back "\n" nil) 4740 (newline)) 4741 (indent-to indent) 4742 (insert details-close-tag) 4743 (markdown-ensure-blank-line-after) 4744 (goto-char b) 4745 ;; if we're on a blank line, insert the quotes here, otherwise 4746 ;; add a new line first 4747 (unless (looking-at-p "\n") 4748 (newline) 4749 (forward-line -1)) 4750 (markdown-ensure-blank-line-before) 4751 (indent-to indent) 4752 (insert details-open-tag "\n") 4753 (insert summary-open-tag summary-close-tag) 4754 (search-backward summary-close-tag)) 4755 (let ((indent (current-indentation))) 4756 (delete-horizontal-space :backward-only) 4757 (markdown-ensure-blank-line-before) 4758 (indent-to indent) 4759 (insert details-open-tag "\n") 4760 (insert summary-open-tag summary-close-tag "\n") 4761 (insert details-close-tag) 4762 (indent-to indent) 4763 (markdown-ensure-blank-line-after) 4764 (search-backward summary-close-tag))))) 4765 4766 4767 ;;; Footnotes ================================================================= 4768 4769 (defun markdown-footnote-counter-inc () 4770 "Increment `markdown-footnote-counter' and return the new value." 4771 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. 4772 (save-excursion 4773 (goto-char (point-min)) 4774 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") 4775 (point-max) t) 4776 (let ((fn (string-to-number (match-string 1)))) 4777 (when (> fn markdown-footnote-counter) 4778 (setq markdown-footnote-counter fn)))))) 4779 (cl-incf markdown-footnote-counter)) 4780 4781 (defun markdown-insert-footnote () 4782 "Insert footnote with a new number and move point to footnote definition." 4783 (interactive) 4784 (let ((fn (markdown-footnote-counter-inc))) 4785 (insert (format "[^%d]" fn)) 4786 (push-mark (point) t) 4787 (markdown-footnote-text-find-new-location) 4788 (markdown-ensure-blank-line-before) 4789 (unless (markdown-cur-line-blank-p) 4790 (insert "\n")) 4791 (insert (format "[^%d]: " fn)) 4792 (markdown-ensure-blank-line-after))) 4793 4794 (defun markdown-footnote-text-find-new-location () 4795 "Position the point at the proper location for a new footnote text." 4796 (cond 4797 ((eq markdown-footnote-location 'end) (goto-char (point-max))) 4798 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) 4799 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) 4800 ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) 4801 4802 (defun markdown-footnote-kill () 4803 "Kill the footnote at point. 4804 The footnote text is killed (and added to the kill ring), the 4805 footnote marker is deleted. Point has to be either at the 4806 footnote marker or in the footnote text." 4807 (interactive) 4808 (let ((marker-pos nil) 4809 (skip-deleting-marker nil) 4810 (starting-footnote-text-positions 4811 (markdown-footnote-text-positions))) 4812 (when starting-footnote-text-positions 4813 ;; We're starting in footnote text, so mark our return position and jump 4814 ;; to the marker if possible. 4815 (let ((marker-pos (markdown-footnote-find-marker 4816 (cl-first starting-footnote-text-positions)))) 4817 (if marker-pos 4818 (goto-char (1- marker-pos)) 4819 ;; If there isn't a marker, we still want to kill the text. 4820 (setq skip-deleting-marker t)))) 4821 ;; Either we didn't start in the text, or we started in the text and jumped 4822 ;; to the marker. We want to assume we're at the marker now and error if 4823 ;; we're not. 4824 (unless skip-deleting-marker 4825 (let ((marker (markdown-footnote-delete-marker))) 4826 (unless marker 4827 (error "Not at a footnote")) 4828 ;; Even if we knew the text position before, it changed when we deleted 4829 ;; the label. 4830 (setq marker-pos (cl-second marker)) 4831 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) 4832 (unless new-text-pos 4833 (error "No text for footnote `%s'" (cl-first marker))) 4834 (goto-char new-text-pos)))) 4835 (let ((pos (markdown-footnote-kill-text))) 4836 (goto-char (if starting-footnote-text-positions 4837 pos 4838 marker-pos))))) 4839 4840 (defun markdown-footnote-delete-marker () 4841 "Delete a footnote marker at point. 4842 Returns a list (ID START) containing the footnote ID and the 4843 start position of the marker before deletion. If no footnote 4844 marker was deleted, this function returns NIL." 4845 (let ((marker (markdown-footnote-marker-positions))) 4846 (when marker 4847 (delete-region (cl-second marker) (cl-third marker)) 4848 (butlast marker)))) 4849 4850 (defun markdown-footnote-kill-text () 4851 "Kill footnote text at point. 4852 Returns the start position of the footnote text before deletion, 4853 or NIL if point was not inside a footnote text. 4854 4855 The killed text is placed in the kill ring (without the footnote 4856 number)." 4857 (let ((fn (markdown-footnote-text-positions))) 4858 (when fn 4859 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) 4860 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) 4861 (kill-new (match-string 1 text)) 4862 (when (and (markdown-cur-line-blank-p) 4863 (markdown-prev-line-blank-p) 4864 (not (bobp))) 4865 (delete-region (1- (point)) (point))) 4866 (cl-second fn))))) 4867 4868 (defun markdown-footnote-goto-text () 4869 "Jump to the text of the footnote at point." 4870 (interactive) 4871 (let ((fn (car (markdown-footnote-marker-positions)))) 4872 (unless fn 4873 (user-error "Not at a footnote marker")) 4874 (let ((new-pos (markdown-footnote-find-text fn))) 4875 (unless new-pos 4876 (error "No definition found for footnote `%s'" fn)) 4877 (goto-char new-pos)))) 4878 4879 (defun markdown-footnote-return () 4880 "Return from a footnote to its footnote number in the main text." 4881 (interactive) 4882 (let ((fn (save-excursion 4883 (car (markdown-footnote-text-positions))))) 4884 (unless fn 4885 (user-error "Not in a footnote")) 4886 (let ((new-pos (markdown-footnote-find-marker fn))) 4887 (unless new-pos 4888 (error "Footnote marker `%s' not found" fn)) 4889 (goto-char new-pos)))) 4890 4891 (defun markdown-footnote-find-marker (id) 4892 "Find the location of the footnote marker with ID. 4893 The actual buffer position returned is the position directly 4894 following the marker's closing bracket. If no marker is found, 4895 NIL is returned." 4896 (save-excursion 4897 (goto-char (point-min)) 4898 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) 4899 (skip-chars-backward "^]") 4900 (point)))) 4901 4902 (defun markdown-footnote-find-text (id) 4903 "Find the location of the text of footnote ID. 4904 The actual buffer position returned is the position of the first 4905 character of the text, after the footnote's identifier. If no 4906 footnote text is found, NIL is returned." 4907 (save-excursion 4908 (goto-char (point-min)) 4909 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) 4910 (skip-chars-forward " \t") 4911 (point)))) 4912 4913 (defun markdown-footnote-marker-positions () 4914 "Return the position and ID of the footnote marker point is on. 4915 The return value is a list (ID START END). If point is not on a 4916 footnote, NIL is returned." 4917 ;; first make sure we're at a footnote marker 4918 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) 4919 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) 4920 (save-excursion 4921 ;; move point between [ and ^: 4922 (if (looking-at-p "\\[") 4923 (forward-char 1) 4924 (skip-chars-backward "^[")) 4925 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) 4926 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) 4927 4928 (defun markdown-footnote-text-positions () 4929 "Return the start and end positions of the footnote text point is in. 4930 The exact return value is a list of three elements: (ID START END). 4931 The start position is the position of the opening bracket 4932 of the footnote id. The end position is directly after the 4933 newline that ends the footnote. If point is not in a footnote, 4934 NIL is returned instead." 4935 (save-excursion 4936 (let (result) 4937 (move-beginning-of-line 1) 4938 ;; Try to find the label. If we haven't found the label and we're at a blank 4939 ;; or indented line, back up if possible. 4940 (while (and 4941 (not (and (looking-at markdown-regex-footnote-definition) 4942 (setq result (list (match-string 1) (point))))) 4943 (and (not (bobp)) 4944 (or (markdown-cur-line-blank-p) 4945 (>= (current-indentation) 4)))) 4946 (forward-line -1)) 4947 (when result 4948 ;; Advance if there is a next line that is either blank or indented. 4949 ;; (Need to check if we're on the last line, because 4950 ;; markdown-next-line-blank-p returns true for last line in buffer.) 4951 (while (and (/= (line-end-position) (point-max)) 4952 (or (markdown-next-line-blank-p) 4953 (>= (markdown-next-line-indent) 4))) 4954 (forward-line)) 4955 ;; Move back while the current line is blank. 4956 (while (markdown-cur-line-blank-p) 4957 (forward-line -1)) 4958 ;; Advance to capture this line and a single trailing newline (if there 4959 ;; is one). 4960 (forward-line) 4961 (append result (list (point))))))) 4962 4963 (defun markdown-get-defined-footnotes () 4964 "Return a list of all defined footnotes. 4965 Result is an alist of pairs (MARKER . LINE), where MARKER is the 4966 footnote marker, a string, and LINE is the line number containing 4967 the footnote definition. 4968 4969 For example, suppose the following footnotes are defined at positions 4970 448 and 475: 4971 4972 \[^1]: First footnote here. 4973 \[^marker]: Second footnote. 4974 4975 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" 4976 (save-excursion 4977 (goto-char (point-min)) 4978 (let (footnotes) 4979 (while (markdown-search-until-condition 4980 (lambda () (and (not (markdown-code-block-at-point-p)) 4981 (not (markdown-inline-code-at-point-p)) 4982 (not (markdown-in-comment-p)))) 4983 markdown-regex-footnote-definition nil t) 4984 (let ((marker (match-string-no-properties 1)) 4985 (pos (match-beginning 0))) 4986 (unless (zerop (length marker)) 4987 (cl-pushnew (cons marker pos) footnotes :test #'equal)))) 4988 (reverse footnotes)))) 4989 4990 4991 ;;; Element Removal =========================================================== 4992 4993 (defun markdown-kill-thing-at-point () 4994 "Kill thing at point and add important text, without markup, to kill ring. 4995 Possible things to kill include (roughly in order of precedence): 4996 inline code, headers, horizontal rules, links (add link text to 4997 kill ring), images (add alt text to kill ring), angle uri, email 4998 addresses, bold, italics, reference definition (add URI to kill 4999 ring), footnote markers and text (kill both marker and text, add 5000 text to kill ring), and list items." 5001 (interactive "*") 5002 (let (val) 5003 (cond 5004 ;; Inline code 5005 ((markdown-inline-code-at-point) 5006 (kill-new (match-string 2)) 5007 (delete-region (match-beginning 0) (match-end 0))) 5008 ;; ATX header 5009 ((thing-at-point-looking-at markdown-regex-header-atx) 5010 (kill-new (match-string 2)) 5011 (delete-region (match-beginning 0) (match-end 0))) 5012 ;; Setext header 5013 ((thing-at-point-looking-at markdown-regex-header-setext) 5014 (kill-new (match-string 1)) 5015 (delete-region (match-beginning 0) (match-end 0))) 5016 ;; Horizontal rule 5017 ((thing-at-point-looking-at markdown-regex-hr) 5018 (kill-new (match-string 0)) 5019 (delete-region (match-beginning 0) (match-end 0))) 5020 ;; Inline link or image (add link or alt text to kill ring) 5021 ((thing-at-point-looking-at markdown-regex-link-inline) 5022 (kill-new (match-string 3)) 5023 (delete-region (match-beginning 0) (match-end 0))) 5024 ;; Reference link or image (add link or alt text to kill ring) 5025 ((thing-at-point-looking-at markdown-regex-link-reference) 5026 (kill-new (match-string 3)) 5027 (delete-region (match-beginning 0) (match-end 0))) 5028 ;; Angle URI (add URL to kill ring) 5029 ((thing-at-point-looking-at markdown-regex-angle-uri) 5030 (kill-new (match-string 2)) 5031 (delete-region (match-beginning 0) (match-end 0))) 5032 ;; Email address in angle brackets (add email address to kill ring) 5033 ((thing-at-point-looking-at markdown-regex-email) 5034 (kill-new (match-string 1)) 5035 (delete-region (match-beginning 0) (match-end 0))) 5036 ;; Wiki link (add alias text to kill ring) 5037 ((and markdown-enable-wiki-links 5038 (thing-at-point-looking-at markdown-regex-wiki-link)) 5039 (kill-new (markdown-wiki-link-alias)) 5040 (delete-region (match-beginning 1) (match-end 1))) 5041 ;; Bold 5042 ((thing-at-point-looking-at markdown-regex-bold) 5043 (kill-new (match-string 4)) 5044 (delete-region (match-beginning 2) (match-end 2))) 5045 ;; Italics 5046 ((thing-at-point-looking-at markdown-regex-italic) 5047 (kill-new (match-string 3)) 5048 (delete-region (match-beginning 1) (match-end 1))) 5049 ;; Strikethrough 5050 ((thing-at-point-looking-at markdown-regex-strike-through) 5051 (kill-new (match-string 4)) 5052 (delete-region (match-beginning 2) (match-end 2))) 5053 ;; Footnote marker (add footnote text to kill ring) 5054 ((thing-at-point-looking-at markdown-regex-footnote) 5055 (markdown-footnote-kill)) 5056 ;; Footnote text (add footnote text to kill ring) 5057 ((setq val (markdown-footnote-text-positions)) 5058 (markdown-footnote-kill)) 5059 ;; Reference definition (add URL to kill ring) 5060 ((thing-at-point-looking-at markdown-regex-reference-definition) 5061 (kill-new (match-string 5)) 5062 (delete-region (match-beginning 0) (match-end 0))) 5063 ;; List item 5064 ((setq val (markdown-cur-list-item-bounds)) 5065 (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) 5066 (t 5067 (user-error "Nothing found at point to kill"))))) 5068 5069 (defun markdown-kill-outline () 5070 "Kill visible heading and add it to `kill-ring'." 5071 (interactive) 5072 (save-excursion 5073 (markdown-outline-previous) 5074 (kill-region (point) (progn (markdown-outline-next) (point))))) 5075 5076 (defun markdown-kill-block () 5077 "Kill visible code block, list item, or blockquote and add it to `kill-ring'." 5078 (interactive) 5079 (save-excursion 5080 (markdown-backward-block) 5081 (kill-region (point) (progn (markdown-forward-block) (point))))) 5082 5083 5084 ;;; Indentation =============================================================== 5085 5086 (defun markdown-indent-find-next-position (cur-pos positions) 5087 "Return the position after the index of CUR-POS in POSITIONS. 5088 Positions are calculated by `markdown-calc-indents'." 5089 (while (and positions 5090 (not (equal cur-pos (car positions)))) 5091 (setq positions (cdr positions))) 5092 (or (cadr positions) 0)) 5093 5094 (defun markdown-outdent-find-next-position (cur-pos positions) 5095 "Return the maximal element that precedes CUR-POS from POSITIONS. 5096 Positions are calculated by `markdown-calc-indents'." 5097 (let ((result 0)) 5098 (dolist (i positions) 5099 (when (< i cur-pos) 5100 (setq result (max result i)))) 5101 result)) 5102 5103 (defun markdown-indent-line () 5104 "Indent the current line using some heuristics. 5105 If the _previous_ command was either `markdown-enter-key' or 5106 `markdown-cycle', then we should cycle to the next 5107 reasonable indentation position. Otherwise, we could have been 5108 called directly by `markdown-enter-key', by an initial call of 5109 `markdown-cycle', or indirectly by `auto-fill-mode'. In 5110 these cases, indent to the default position. 5111 Positions are calculated by `markdown-calc-indents'." 5112 (interactive) 5113 (let ((positions (markdown-calc-indents)) 5114 (point-pos (current-column)) 5115 (_ (back-to-indentation)) 5116 (cur-pos (current-column))) 5117 (if (not (equal this-command 'markdown-cycle)) 5118 (indent-line-to (car positions)) 5119 (setq positions (sort (delete-dups positions) '<)) 5120 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) 5121 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) 5122 (indent-line-to next-pos) 5123 (move-to-column new-point-pos))))) 5124 5125 (defun markdown-calc-indents () 5126 "Return a list of indentation columns to cycle through. 5127 The first element in the returned list should be considered the 5128 default indentation level. This function does not worry about 5129 duplicate positions, which are handled up by calling functions." 5130 (let (pos prev-line-pos positions) 5131 5132 ;; Indentation of previous line 5133 (setq prev-line-pos (markdown-prev-line-indent)) 5134 (setq positions (cons prev-line-pos positions)) 5135 5136 ;; Indentation of previous non-list-marker text 5137 (when (setq pos (save-excursion 5138 (forward-line -1) 5139 (when (looking-at markdown-regex-list) 5140 (- (match-end 3) (match-beginning 0))))) 5141 (setq positions (cons pos positions))) 5142 5143 ;; Indentation required for a pre block in current context 5144 (setq pos (length (markdown-pre-indentation (point)))) 5145 (setq positions (cons pos positions)) 5146 5147 ;; Indentation of the previous line + tab-width 5148 (if prev-line-pos 5149 (setq positions (cons (+ prev-line-pos tab-width) positions)) 5150 (setq positions (cons tab-width positions))) 5151 5152 ;; Indentation of the previous line - tab-width 5153 (if (and prev-line-pos (> prev-line-pos tab-width)) 5154 (setq positions (cons (- prev-line-pos tab-width) positions))) 5155 5156 ;; Indentation of all preceding list markers (when in a list) 5157 (when (setq pos (markdown-calculate-list-levels)) 5158 (setq positions (append pos positions))) 5159 5160 ;; First column 5161 (setq positions (cons 0 positions)) 5162 5163 ;; Return reversed list 5164 (reverse positions))) 5165 5166 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent 5167 "Handle RET depending on the context. 5168 If the point is at a table, move to the next row. Otherwise, 5169 indent according to value of `markdown-indent-on-enter'. 5170 When it is nil, simply call `newline'. Otherwise, indent the next line 5171 following RET using `markdown-indent-line'. Furthermore, when it 5172 is set to \\='indent-and-new-item and the point is in a list item, 5173 start a new item with the same indentation. If the point is in an 5174 empty list item, remove it (so that pressing RET twice when in a 5175 list simply adds a blank line)." 5176 (interactive) 5177 (cond 5178 ;; Table 5179 ((markdown-table-at-point-p) 5180 (call-interactively #'markdown-table-next-row)) 5181 ;; Indent non-table text 5182 (markdown-indent-on-enter 5183 (let (bounds) 5184 (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) 5185 (setq bounds (markdown-cur-list-item-bounds))) 5186 (let ((beg (cl-first bounds)) 5187 (end (cl-second bounds)) 5188 (nonlist-indent (cl-fourth bounds)) 5189 (checkbox (cl-sixth bounds))) 5190 ;; Point is in a list item 5191 (if (= (- end beg) (+ nonlist-indent (length checkbox))) 5192 ;; Delete blank list 5193 (progn 5194 (delete-region beg end) 5195 (newline) 5196 (markdown-indent-line)) 5197 (call-interactively #'markdown-insert-list-item))) 5198 ;; Point is not in a list 5199 (newline) 5200 (markdown-indent-line)))) 5201 ;; Insert a raw newline 5202 (t (newline)))) 5203 5204 (defun markdown-outdent-or-delete (arg) 5205 "Handle BACKSPACE by cycling through indentation points. 5206 When BACKSPACE is pressed, if there is only whitespace 5207 before the current point, then outdent the line one level. 5208 Otherwise, do normal delete by repeating 5209 `backward-delete-char-untabify' ARG times." 5210 (interactive "*p") 5211 (if (use-region-p) 5212 (backward-delete-char-untabify arg) 5213 (let ((cur-pos (current-column)) 5214 (start-of-indention (save-excursion 5215 (back-to-indentation) 5216 (current-column))) 5217 (positions (markdown-calc-indents))) 5218 (if (and (> cur-pos 0) (= cur-pos start-of-indention)) 5219 (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) 5220 (backward-delete-char-untabify arg))))) 5221 5222 (defun markdown-find-leftmost-column (beg end) 5223 "Find the leftmost column in the region from BEG to END." 5224 (let ((mincol 1000)) 5225 (save-excursion 5226 (goto-char beg) 5227 (while (< (point) end) 5228 (back-to-indentation) 5229 (unless (looking-at-p "[ \t]*$") 5230 (setq mincol (min mincol (current-column)))) 5231 (forward-line 1) 5232 )) 5233 mincol)) 5234 5235 (defun markdown-indent-region (beg end arg) 5236 "Indent the region from BEG to END using some heuristics. 5237 When ARG is non-nil, outdent the region instead. 5238 See `markdown-indent-line' and `markdown-indent-line'." 5239 (interactive "*r\nP") 5240 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) 5241 (leftmostcol (markdown-find-leftmost-column beg end)) 5242 (next-pos (if arg 5243 (markdown-outdent-find-next-position leftmostcol positions) 5244 (markdown-indent-find-next-position leftmostcol positions)))) 5245 (indent-rigidly beg end (- next-pos leftmostcol)) 5246 (setq deactivate-mark nil))) 5247 5248 (defun markdown-outdent-region (beg end) 5249 "Call `markdown-indent-region' on region from BEG to END with prefix." 5250 (interactive "*r") 5251 (markdown-indent-region beg end t)) 5252 5253 (defun markdown--indent-region (start end) 5254 (let ((deactivate-mark nil)) 5255 (save-excursion 5256 (goto-char end) 5257 (setq end (point-marker)) 5258 (goto-char start) 5259 (when (bolp) 5260 (forward-line 1)) 5261 (while (< (point) end) 5262 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) 5263 (indent-according-to-mode)) 5264 (forward-line 1)) 5265 (move-marker end nil)))) 5266 5267 5268 ;;; Markup Completion ========================================================= 5269 5270 (defconst markdown-complete-alist 5271 '((markdown-regex-header-atx . markdown-complete-atx) 5272 (markdown-regex-header-setext . markdown-complete-setext) 5273 (markdown-regex-hr . markdown-complete-hr)) 5274 "Association list of form (regexp . function) for markup completion.") 5275 5276 (defun markdown-incomplete-atx-p () 5277 "Return t if ATX header markup is incomplete and nil otherwise. 5278 Assumes match data is available for `markdown-regex-header-atx'. 5279 Checks that the number of trailing hash marks equals the number of leading 5280 hash marks, that there is only a single space before and after the text, 5281 and that there is no extraneous whitespace in the text." 5282 (or 5283 ;; Number of starting and ending hash marks differs 5284 (not (= (length (match-string 1)) (length (match-string 3)))) 5285 ;; When the header text is not empty... 5286 (and (> (length (match-string 2)) 0) 5287 ;; ...if there are extra leading, trailing, or interior spaces 5288 (or (not (= (match-beginning 2) (1+ (match-end 1)))) 5289 (not (= (match-beginning 3) (1+ (match-end 2)))) 5290 (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) 5291 ;; When the header text is empty... 5292 (and (= (length (match-string 2)) 0) 5293 ;; ...if there are too many or too few spaces 5294 (not (= (match-beginning 3) (+ (match-end 1) 2)))))) 5295 5296 (defun markdown-complete-atx () 5297 "Complete and normalize ATX headers. 5298 Add or remove hash marks to the end of the header to match the 5299 beginning. Ensure that there is only a single space between hash 5300 marks and header text. Removes extraneous whitespace from header text. 5301 Assumes match data is available for `markdown-regex-header-atx'. 5302 Return nil if markup was complete and non-nil if markup was completed." 5303 (when (markdown-incomplete-atx-p) 5304 (let* ((new-marker (make-marker)) 5305 (new-marker (set-marker new-marker (match-end 2)))) 5306 ;; Hash marks and spacing at end 5307 (goto-char (match-end 2)) 5308 (delete-region (match-end 2) (match-end 3)) 5309 (insert " " (match-string 1)) 5310 ;; Remove extraneous whitespace from title 5311 (replace-match (markdown-compress-whitespace-string (match-string 2)) 5312 t t nil 2) 5313 ;; Spacing at beginning 5314 (goto-char (match-end 1)) 5315 (delete-region (match-end 1) (match-beginning 2)) 5316 (insert " ") 5317 ;; Leave point at end of text 5318 (goto-char new-marker)))) 5319 5320 (defun markdown-incomplete-setext-p () 5321 "Return t if setext header markup is incomplete and nil otherwise. 5322 Assumes match data is available for `markdown-regex-header-setext'. 5323 Checks that length of underline matches text and that there is no 5324 extraneous whitespace in the text." 5325 (or (not (= (length (match-string 1)) (length (match-string 2)))) 5326 (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) 5327 5328 (defun markdown-complete-setext () 5329 "Complete and normalize setext headers. 5330 Add or remove underline characters to match length of header 5331 text. Removes extraneous whitespace from header text. Assumes 5332 match data is available for `markdown-regex-header-setext'. 5333 Return nil if markup was complete and non-nil if markup was completed." 5334 (when (markdown-incomplete-setext-p) 5335 (let* ((text (markdown-compress-whitespace-string (match-string 1))) 5336 (char (char-after (match-beginning 2))) 5337 (level (if (char-equal char ?-) 2 1))) 5338 (goto-char (match-beginning 0)) 5339 (delete-region (match-beginning 0) (match-end 0)) 5340 (markdown-insert-header level text t) 5341 t))) 5342 5343 (defun markdown-incomplete-hr-p () 5344 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. 5345 Assumes match data is available for `markdown-regex-hr'." 5346 (not (member (match-string 0) markdown-hr-strings))) 5347 5348 (defun markdown-complete-hr () 5349 "Complete horizontal rules. 5350 If horizontal rule string is a member of `markdown-hr-strings', 5351 do nothing. Otherwise, replace with the car of 5352 `markdown-hr-strings'. 5353 Assumes match data is available for `markdown-regex-hr'. 5354 Return nil if markup was complete and non-nil if markup was completed." 5355 (when (markdown-incomplete-hr-p) 5356 (replace-match (car markdown-hr-strings)) 5357 t)) 5358 5359 (defun markdown-complete () 5360 "Complete markup of object near point or in region when active. 5361 Handle all objects in `markdown-complete-alist', in order. 5362 See `markdown-complete-at-point' and `markdown-complete-region'." 5363 (interactive "*") 5364 (if (use-region-p) 5365 (markdown-complete-region (region-beginning) (region-end)) 5366 (markdown-complete-at-point))) 5367 5368 (defun markdown-complete-at-point () 5369 "Complete markup of object near point. 5370 Handle all elements of `markdown-complete-alist' in order." 5371 (interactive "*") 5372 (let ((list markdown-complete-alist) found changed) 5373 (while list 5374 (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? 5375 (function (cdar list))) 5376 (setq list (cdr list)) 5377 (when (thing-at-point-looking-at regexp) 5378 (setq found t) 5379 (setq changed (funcall function)) 5380 (setq list nil)))) 5381 (if found 5382 (or changed (user-error "Markup at point is complete")) 5383 (user-error "Nothing to complete at point")))) 5384 5385 (defun markdown-complete-region (beg end) 5386 "Complete markup of objects in region from BEG to END. 5387 Handle all objects in `markdown-complete-alist', in order. Each 5388 match is checked to ensure that a previous regexp does not also 5389 match." 5390 (interactive "*r") 5391 (let ((end-marker (set-marker (make-marker) end)) 5392 previous) 5393 (dolist (element markdown-complete-alist) 5394 (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? 5395 (function (cdr element))) 5396 (goto-char beg) 5397 (while (re-search-forward regexp end-marker 'limit) 5398 (when (match-string 0) 5399 ;; Make sure this is not a match for any of the preceding regexps. 5400 ;; This prevents mistaking an HR for a Setext subheading. 5401 (let (match) 5402 (save-match-data 5403 (dolist (prev-regexp previous) 5404 (or match (setq match (looking-back prev-regexp nil))))) 5405 (unless match 5406 (save-excursion (funcall function)))))) 5407 (cl-pushnew regexp previous :test #'equal))) 5408 previous)) 5409 5410 (defun markdown-complete-buffer () 5411 "Complete markup for all objects in the current buffer." 5412 (interactive "*") 5413 (markdown-complete-region (point-min) (point-max))) 5414 5415 5416 ;;; Markup Cycling ============================================================ 5417 5418 (defun markdown-cycle-atx (arg &optional remove) 5419 "Cycle ATX header markup. 5420 Promote header (decrease level) when ARG is 1 and demote 5421 header (increase level) if arg is -1. When REMOVE is non-nil, 5422 remove the header when the level reaches zero and stop cycling 5423 when it reaches six. Otherwise, perform a proper cycling through 5424 levels one through six. Assumes match data is available for 5425 `markdown-regex-header-atx'." 5426 (let* ((old-level (length (match-string 1))) 5427 (new-level (+ old-level arg)) 5428 (text (match-string 2))) 5429 (when (not remove) 5430 (setq new-level (% new-level 6)) 5431 (setq new-level (cond ((= new-level 0) 6) 5432 ((< new-level 0) (+ new-level 6)) 5433 (t new-level)))) 5434 (cond 5435 ((= new-level 0) 5436 (markdown-unwrap-thing-at-point nil 0 2)) 5437 ((<= new-level 6) 5438 (goto-char (match-beginning 0)) 5439 (delete-region (match-beginning 0) (match-end 0)) 5440 (markdown-insert-header new-level text nil))))) 5441 5442 (defun markdown-cycle-setext (arg &optional remove) 5443 "Cycle setext header markup. 5444 Promote header (increase level) when ARG is 1 and demote 5445 header (decrease level or remove) if arg is -1. When demoting a 5446 level-two setext header, replace with a level-three atx header. 5447 When REMOVE is non-nil, remove the header when the level reaches 5448 zero. Otherwise, cycle back to a level six atx header. Assumes 5449 match data is available for `markdown-regex-header-setext'." 5450 (let* ((char (char-after (match-beginning 2))) 5451 (old-level (if (char-equal char ?=) 1 2)) 5452 (new-level (+ old-level arg))) 5453 (when (and (not remove) (= new-level 0)) 5454 (setq new-level 6)) 5455 (cond 5456 ((= new-level 0) 5457 (markdown-unwrap-thing-at-point nil 0 1)) 5458 ((<= new-level 2) 5459 (markdown-insert-header new-level nil t)) 5460 ((<= new-level 6) 5461 (markdown-insert-header new-level nil nil))))) 5462 5463 (defun markdown-cycle-hr (arg &optional remove) 5464 "Cycle string used for horizontal rule from `markdown-hr-strings'. 5465 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle 5466 backwards (promote). When REMOVE is non-nil, remove the hr instead 5467 of cycling when the end of the list is reached. 5468 Assumes match data is available for `markdown-regex-hr'." 5469 (let* ((strings (if (= arg -1) 5470 (reverse markdown-hr-strings) 5471 markdown-hr-strings)) 5472 (tail (member (match-string 0) strings)) 5473 (new (or (cadr tail) 5474 (if remove 5475 (if (= arg 1) 5476 "" 5477 (car tail)) 5478 (car strings))))) 5479 (replace-match new))) 5480 5481 (defun markdown-cycle-bold () 5482 "Cycle bold markup between underscores and asterisks. 5483 Assumes match data is available for `markdown-regex-bold'." 5484 (save-excursion 5485 (let* ((old-delim (match-string 3)) 5486 (new-delim (if (string-equal old-delim "**") "__" "**"))) 5487 (replace-match new-delim t t nil 3) 5488 (replace-match new-delim t t nil 5)))) 5489 5490 (defun markdown-cycle-italic () 5491 "Cycle italic markup between underscores and asterisks. 5492 Assumes match data is available for `markdown-regex-italic'." 5493 (save-excursion 5494 (let* ((old-delim (match-string 2)) 5495 (new-delim (if (string-equal old-delim "*") "_" "*"))) 5496 (replace-match new-delim t t nil 2) 5497 (replace-match new-delim t t nil 4)))) 5498 5499 5500 ;;; Keymap ==================================================================== 5501 5502 (defun markdown--style-map-prompt () 5503 "Return a formatted prompt for Markdown markup insertion." 5504 (when markdown-enable-prefix-prompts 5505 (concat 5506 "Markdown: " 5507 (propertize "bold" 'face 'markdown-bold-face) ", " 5508 (propertize "italic" 'face 'markdown-italic-face) ", " 5509 (propertize "code" 'face 'markdown-inline-code-face) ", " 5510 (propertize "C = GFM code" 'face 'markdown-code-face) ", " 5511 (propertize "pre" 'face 'markdown-pre-face) ", " 5512 (propertize "footnote" 'face 'markdown-footnote-text-face) ", " 5513 (propertize "F = foldable" 'face 'markdown-bold-face) ", " 5514 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " 5515 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " 5516 (propertize "- = hr" 'face 'markdown-hr-face) ", " 5517 "C-h = more"))) 5518 5519 (defun markdown--command-map-prompt () 5520 "Return prompt for Markdown buffer-wide commands." 5521 (when markdown-enable-prefix-prompts 5522 (concat 5523 "Command: " 5524 (propertize "m" 'face 'markdown-bold-face) "arkdown, " 5525 (propertize "p" 'face 'markdown-bold-face) "review, " 5526 (propertize "o" 'face 'markdown-bold-face) "pen, " 5527 (propertize "e" 'face 'markdown-bold-face) "xport, " 5528 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " 5529 (propertize "c" 'face 'markdown-bold-face) "heck refs, " 5530 (propertize "u" 'face 'markdown-bold-face) "nused refs, " 5531 "C-h = more"))) 5532 5533 (defvar markdown-mode-style-map 5534 (let ((map (make-keymap (markdown--style-map-prompt)))) 5535 (define-key map (kbd "1") 'markdown-insert-header-atx-1) 5536 (define-key map (kbd "2") 'markdown-insert-header-atx-2) 5537 (define-key map (kbd "3") 'markdown-insert-header-atx-3) 5538 (define-key map (kbd "4") 'markdown-insert-header-atx-4) 5539 (define-key map (kbd "5") 'markdown-insert-header-atx-5) 5540 (define-key map (kbd "6") 'markdown-insert-header-atx-6) 5541 (define-key map (kbd "!") 'markdown-insert-header-setext-1) 5542 (define-key map (kbd "@") 'markdown-insert-header-setext-2) 5543 (define-key map (kbd "b") 'markdown-insert-bold) 5544 (define-key map (kbd "c") 'markdown-insert-code) 5545 (define-key map (kbd "C") 'markdown-insert-gfm-code-block) 5546 (define-key map (kbd "f") 'markdown-insert-footnote) 5547 (define-key map (kbd "F") 'markdown-insert-foldable-block) 5548 (define-key map (kbd "h") 'markdown-insert-header-dwim) 5549 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) 5550 (define-key map (kbd "i") 'markdown-insert-italic) 5551 (define-key map (kbd "k") 'markdown-insert-kbd) 5552 (define-key map (kbd "l") 'markdown-insert-link) 5553 (define-key map (kbd "p") 'markdown-insert-pre) 5554 (define-key map (kbd "P") 'markdown-pre-region) 5555 (define-key map (kbd "q") 'markdown-insert-blockquote) 5556 (define-key map (kbd "s") 'markdown-insert-strike-through) 5557 (define-key map (kbd "t") 'markdown-insert-table) 5558 (define-key map (kbd "Q") 'markdown-blockquote-region) 5559 (define-key map (kbd "w") 'markdown-insert-wiki-link) 5560 (define-key map (kbd "-") 'markdown-insert-hr) 5561 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) 5562 ;; Deprecated keys that may be removed in a future version 5563 (define-key map (kbd "e") 'markdown-insert-italic) 5564 map) 5565 "Keymap for Markdown text styling commands.") 5566 5567 (defvar markdown-mode-command-map 5568 (let ((map (make-keymap (markdown--command-map-prompt)))) 5569 (define-key map (kbd "m") 'markdown-other-window) 5570 (define-key map (kbd "p") 'markdown-preview) 5571 (define-key map (kbd "e") 'markdown-export) 5572 (define-key map (kbd "v") 'markdown-export-and-preview) 5573 (define-key map (kbd "o") 'markdown-open) 5574 (define-key map (kbd "l") 'markdown-live-preview-mode) 5575 (define-key map (kbd "w") 'markdown-kill-ring-save) 5576 (define-key map (kbd "c") 'markdown-check-refs) 5577 (define-key map (kbd "u") 'markdown-unused-refs) 5578 (define-key map (kbd "n") 'markdown-cleanup-list-numbers) 5579 (define-key map (kbd "]") 'markdown-complete-buffer) 5580 (define-key map (kbd "^") 'markdown-table-sort-lines) 5581 (define-key map (kbd "|") 'markdown-table-convert-region) 5582 (define-key map (kbd "t") 'markdown-table-transpose) 5583 map) 5584 "Keymap for Markdown buffer-wide commands.") 5585 5586 (defvar markdown-mode-map 5587 (let ((map (make-keymap))) 5588 ;; Markup insertion & removal 5589 (define-key map (kbd "C-c C-s") markdown-mode-style-map) 5590 (define-key map (kbd "C-c C-l") 'markdown-insert-link) 5591 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) 5592 ;; Promotion, demotion, and cycling 5593 (define-key map (kbd "C-c C--") 'markdown-promote) 5594 (define-key map (kbd "C-c C-=") 'markdown-demote) 5595 (define-key map (kbd "C-c C-]") 'markdown-complete) 5596 ;; Following and doing things 5597 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) 5598 (define-key map (kbd "C-c C-d") 'markdown-do) 5599 (define-key map (kbd "C-c '") 'markdown-edit-code-block) 5600 ;; Indentation 5601 (define-key map (kbd "RET") 'markdown-enter-key) 5602 (define-key map (kbd "DEL") 'markdown-outdent-or-delete) 5603 (define-key map (kbd "C-c >") 'markdown-indent-region) 5604 (define-key map (kbd "C-c <") 'markdown-outdent-region) 5605 ;; Visibility cycling 5606 (define-key map (kbd "TAB") 'markdown-cycle) 5607 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by 5608 ;; (local-)function-key-map. 5609 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) 5610 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) 5611 (define-key map (kbd "<backtab>") 'markdown-shifttab) 5612 ;; Heading and list navigation 5613 (define-key map (kbd "C-c C-n") 'markdown-outline-next) 5614 (define-key map (kbd "C-c C-p") 'markdown-outline-previous) 5615 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) 5616 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) 5617 (define-key map (kbd "C-c C-u") 'markdown-outline-up) 5618 ;; Buffer-wide commands 5619 (define-key map (kbd "C-c C-c") markdown-mode-command-map) 5620 ;; Subtree, list, and table editing 5621 (define-key map (kbd "C-c <up>") 'markdown-move-up) 5622 (define-key map (kbd "C-c <down>") 'markdown-move-down) 5623 (define-key map (kbd "C-c <left>") 'markdown-promote) 5624 (define-key map (kbd "C-c <right>") 'markdown-demote) 5625 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) 5626 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) 5627 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) 5628 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) 5629 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) 5630 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) 5631 (define-key map (kbd "M-RET") 'markdown-insert-list-item) 5632 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) 5633 ;; Lines 5634 (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) 5635 (define-key map [remap move-end-of-line] 'markdown-end-of-line) 5636 ;; Paragraphs (Markdown context aware) 5637 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) 5638 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) 5639 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) 5640 ;; Blocks (one or more paragraphs) 5641 (define-key map (kbd "C-M-{") 'markdown-backward-block) 5642 (define-key map (kbd "C-M-}") 'markdown-forward-block) 5643 (define-key map (kbd "C-c M-h") 'markdown-mark-block) 5644 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) 5645 ;; Pages (top-level sections) 5646 (define-key map [remap backward-page] 'markdown-backward-page) 5647 (define-key map [remap forward-page] 'markdown-forward-page) 5648 (define-key map [remap mark-page] 'markdown-mark-page) 5649 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) 5650 ;; Link Movement 5651 (define-key map (kbd "M-n") 'markdown-next-link) 5652 (define-key map (kbd "M-p") 'markdown-previous-link) 5653 ;; Toggling functionality 5654 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) 5655 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) 5656 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) 5657 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) 5658 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) 5659 ;; Alternative keys (in case of problems with the arrow keys) 5660 (define-key map (kbd "C-c C-x u") 'markdown-move-up) 5661 (define-key map (kbd "C-c C-x d") 'markdown-move-down) 5662 (define-key map (kbd "C-c C-x l") 'markdown-promote) 5663 (define-key map (kbd "C-c C-x r") 'markdown-demote) 5664 ;; Deprecated keys that may be removed in a future version 5665 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l 5666 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l 5667 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l 5668 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l 5669 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) 5670 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) 5671 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) 5672 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) 5673 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) 5674 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) 5675 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) 5676 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) 5677 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) 5678 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) 5679 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) 5680 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) 5681 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) 5682 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) 5683 (define-key map (kbd "C-c C-i") 'markdown-insert-image) 5684 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j 5685 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d 5686 (define-key map (kbd "C-c -") 'markdown-insert-hr) 5687 map) 5688 "Keymap for Markdown major mode.") 5689 5690 (defvar markdown-mode-mouse-map 5691 (when markdown-mouse-follow-link 5692 (let ((map (make-sparse-keymap))) 5693 (define-key map [follow-link] 'mouse-face) 5694 (define-key map [mouse-2] #'markdown-follow-thing-at-point) 5695 map)) 5696 "Keymap for following links with mouse.") 5697 5698 (defvar gfm-mode-map 5699 (let ((map (make-sparse-keymap))) 5700 (set-keymap-parent map markdown-mode-map) 5701 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) 5702 (define-key map "`" 'markdown-electric-backquote) 5703 map) 5704 "Keymap for `gfm-mode'. 5705 See also `markdown-mode-map'.") 5706 5707 5708 ;;; Menu ====================================================================== 5709 5710 (easy-menu-define markdown-mode-menu markdown-mode-map 5711 "Menu for Markdown mode." 5712 '("Markdown" 5713 "---" 5714 ("Movement" 5715 ["Jump" markdown-do] 5716 ["Follow Link" markdown-follow-thing-at-point] 5717 ["Next Link" markdown-next-link] 5718 ["Previous Link" markdown-previous-link] 5719 "---" 5720 ["Next Heading or List Item" markdown-outline-next] 5721 ["Previous Heading or List Item" markdown-outline-previous] 5722 ["Next at Same Level" markdown-outline-next-same-level] 5723 ["Previous at Same Level" markdown-outline-previous-same-level] 5724 ["Up to Parent" markdown-outline-up] 5725 "---" 5726 ["Forward Paragraph" markdown-forward-paragraph] 5727 ["Backward Paragraph" markdown-backward-paragraph] 5728 ["Forward Block" markdown-forward-block] 5729 ["Backward Block" markdown-backward-block]) 5730 ("Show & Hide" 5731 ["Cycle Heading Visibility" markdown-cycle 5732 :enable (markdown-on-heading-p)] 5733 ["Cycle Heading Visibility (Global)" markdown-shifttab] 5734 "---" 5735 ["Narrow to Region" narrow-to-region] 5736 ["Narrow to Block" markdown-narrow-to-block] 5737 ["Narrow to Section" narrow-to-defun] 5738 ["Narrow to Subtree" markdown-narrow-to-subtree] 5739 ["Widen" widen (buffer-narrowed-p)] 5740 "---" 5741 ["Toggle Markup Hiding" markdown-toggle-markup-hiding 5742 :keys "C-c C-x C-m" 5743 :style radio 5744 :selected markdown-hide-markup]) 5745 "---" 5746 ("Headings & Structure" 5747 ["Automatic Heading" markdown-insert-header-dwim 5748 :keys "C-c C-s h"] 5749 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim 5750 :keys "C-c C-s H"] 5751 ("Specific Heading (atx)" 5752 ["First Level atx" markdown-insert-header-atx-1 5753 :keys "C-c C-s 1"] 5754 ["Second Level atx" markdown-insert-header-atx-2 5755 :keys "C-c C-s 2"] 5756 ["Third Level atx" markdown-insert-header-atx-3 5757 :keys "C-c C-s 3"] 5758 ["Fourth Level atx" markdown-insert-header-atx-4 5759 :keys "C-c C-s 4"] 5760 ["Fifth Level atx" markdown-insert-header-atx-5 5761 :keys "C-c C-s 5"] 5762 ["Sixth Level atx" markdown-insert-header-atx-6 5763 :keys "C-c C-s 6"]) 5764 ("Specific Heading (Setext)" 5765 ["First Level Setext" markdown-insert-header-setext-1 5766 :keys "C-c C-s !"] 5767 ["Second Level Setext" markdown-insert-header-setext-2 5768 :keys "C-c C-s @"]) 5769 ["Horizontal Rule" markdown-insert-hr 5770 :keys "C-c C-s -"] 5771 "---" 5772 ["Move Subtree Up" markdown-move-up 5773 :keys "C-c <up>"] 5774 ["Move Subtree Down" markdown-move-down 5775 :keys "C-c <down>"] 5776 ["Promote Subtree" markdown-promote 5777 :keys "C-c <left>"] 5778 ["Demote Subtree" markdown-demote 5779 :keys "C-c <right>"]) 5780 ("Region & Mark" 5781 ["Indent Region" markdown-indent-region] 5782 ["Outdent Region" markdown-outdent-region] 5783 "--" 5784 ["Mark Paragraph" mark-paragraph] 5785 ["Mark Block" markdown-mark-block] 5786 ["Mark Section" mark-defun] 5787 ["Mark Subtree" markdown-mark-subtree]) 5788 ("Tables" 5789 ["Move Row Up" markdown-move-up 5790 :enable (markdown-table-at-point-p) 5791 :keys "C-c <up>"] 5792 ["Move Row Down" markdown-move-down 5793 :enable (markdown-table-at-point-p) 5794 :keys "C-c <down>"] 5795 ["Move Column Left" markdown-promote 5796 :enable (markdown-table-at-point-p) 5797 :keys "C-c <left>"] 5798 ["Move Column Right" markdown-demote 5799 :enable (markdown-table-at-point-p) 5800 :keys "C-c <right>"] 5801 ["Delete Row" markdown-table-delete-row 5802 :enable (markdown-table-at-point-p)] 5803 ["Insert Row" markdown-table-insert-row 5804 :enable (markdown-table-at-point-p)] 5805 ["Delete Column" markdown-table-delete-column 5806 :enable (markdown-table-at-point-p)] 5807 ["Insert Column" markdown-table-insert-column 5808 :enable (markdown-table-at-point-p)] 5809 ["Insert Table" markdown-insert-table] 5810 "--" 5811 ["Convert Region to Table" markdown-table-convert-region] 5812 ["Sort Table Lines" markdown-table-sort-lines 5813 :enable (markdown-table-at-point-p)] 5814 ["Transpose Table" markdown-table-transpose 5815 :enable (markdown-table-at-point-p)]) 5816 ("Lists" 5817 ["Insert List Item" markdown-insert-list-item] 5818 ["Move Subtree Up" markdown-move-up 5819 :keys "C-c <up>"] 5820 ["Move Subtree Down" markdown-move-down 5821 :keys "C-c <down>"] 5822 ["Indent Subtree" markdown-demote 5823 :keys "C-c <right>"] 5824 ["Outdent Subtree" markdown-promote 5825 :keys "C-c <left>"] 5826 ["Renumber List" markdown-cleanup-list-numbers] 5827 ["Insert Task List Item" markdown-insert-gfm-checkbox 5828 :keys "C-c C-x ["] 5829 ["Toggle Task List Item" markdown-toggle-gfm-checkbox 5830 :enable (markdown-gfm-task-list-item-at-point) 5831 :keys "C-c C-d"]) 5832 ("Links & Images" 5833 ["Insert Link" markdown-insert-link] 5834 ["Insert Image" markdown-insert-image] 5835 ["Insert Footnote" markdown-insert-footnote 5836 :keys "C-c C-s f"] 5837 ["Insert Wiki Link" markdown-insert-wiki-link 5838 :keys "C-c C-s w"] 5839 "---" 5840 ["Check References" markdown-check-refs] 5841 ["Find Unused References" markdown-unused-refs] 5842 ["Toggle URL Hiding" markdown-toggle-url-hiding 5843 :style radio 5844 :selected markdown-hide-urls] 5845 ["Toggle Inline Images" markdown-toggle-inline-images 5846 :keys "C-c C-x C-i" 5847 :style radio 5848 :selected markdown-inline-image-overlays] 5849 ["Toggle Wiki Links" markdown-toggle-wiki-links 5850 :style radio 5851 :selected markdown-enable-wiki-links]) 5852 ("Styles" 5853 ["Bold" markdown-insert-bold] 5854 ["Italic" markdown-insert-italic] 5855 ["Code" markdown-insert-code] 5856 ["Strikethrough" markdown-insert-strike-through] 5857 ["Keyboard" markdown-insert-kbd] 5858 "---" 5859 ["Blockquote" markdown-insert-blockquote] 5860 ["Preformatted" markdown-insert-pre] 5861 ["GFM Code Block" markdown-insert-gfm-code-block] 5862 ["Edit Code Block" markdown-edit-code-block 5863 :enable (markdown-code-block-at-point-p)] 5864 ["Foldable Block" markdown-insert-foldable-block] 5865 "---" 5866 ["Blockquote Region" markdown-blockquote-region] 5867 ["Preformatted Region" markdown-pre-region] 5868 "---" 5869 ["Fontify Code Blocks Natively" 5870 markdown-toggle-fontify-code-blocks-natively 5871 :style radio 5872 :selected markdown-fontify-code-blocks-natively] 5873 ["LaTeX Math Support" markdown-toggle-math 5874 :style radio 5875 :selected markdown-enable-math]) 5876 "---" 5877 ("Preview & Export" 5878 ["Compile" markdown-other-window] 5879 ["Preview" markdown-preview] 5880 ["Export" markdown-export] 5881 ["Export & View" markdown-export-and-preview] 5882 ["Open" markdown-open] 5883 ["Live Export" markdown-live-preview-mode 5884 :style radio 5885 :selected markdown-live-preview-mode] 5886 ["Kill ring save" markdown-kill-ring-save]) 5887 ("Markup Completion and Cycling" 5888 ["Complete Markup" markdown-complete] 5889 ["Promote Element" markdown-promote 5890 :keys "C-c C--"] 5891 ["Demote Element" markdown-demote 5892 :keys "C-c C-="]) 5893 "---" 5894 ["Kill Element" markdown-kill-thing-at-point] 5895 "---" 5896 ("Documentation" 5897 ["Version" markdown-show-version] 5898 ["Homepage" markdown-mode-info] 5899 ["Describe Mode" (describe-function 'markdown-mode)] 5900 ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) 5901 5902 5903 ;;; imenu ===================================================================== 5904 5905 (defun markdown-imenu-create-nested-index () 5906 "Create and return a nested imenu index alist for the current buffer. 5907 See `imenu-create-index-function' and `imenu--index-alist' for details." 5908 (let* ((root (list nil)) 5909 (min-level 9999) 5910 hashes headers) 5911 (save-excursion 5912 ;; Headings 5913 (goto-char (point-min)) 5914 (while (re-search-forward markdown-regex-header (point-max) t) 5915 (unless (or (markdown-code-block-at-point-p) 5916 (and (match-beginning 3) 5917 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) 5918 (cond 5919 ((match-string-no-properties 2) ;; level 1 setext 5920 (setq min-level 1) 5921 (push (list :heading (match-string-no-properties 1) 5922 :point (match-beginning 1) 5923 :level 1) headers)) 5924 ((match-string-no-properties 3) ;; level 2 setext 5925 (setq min-level (min min-level 2)) 5926 (push (list :heading (match-string-no-properties 1) 5927 :point (match-beginning 1) 5928 :level (- 2 (1- min-level))) headers)) 5929 ((setq hashes (markdown-trim-whitespace 5930 (match-string-no-properties 4))) 5931 (setq min-level (min min-level (length hashes))) 5932 (push (list :heading (match-string-no-properties 5) 5933 :point (match-beginning 4) 5934 :level (- (length hashes) (1- min-level))) headers))))) 5935 (cl-loop with cur-level = 0 5936 with cur-alist = nil 5937 with empty-heading = "-" 5938 with self-heading = "." 5939 for header in (reverse headers) 5940 for level = (plist-get header :level) 5941 do 5942 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) 5943 (cond 5944 ((= cur-level level) ; new sibling 5945 (setcdr cur-alist alist) 5946 (setq cur-alist alist)) 5947 ((< cur-level level) ; first child 5948 (dotimes (_ (- level cur-level 1)) 5949 (setq alist (list (cons empty-heading alist)))) 5950 (if cur-alist 5951 (let* ((parent (car cur-alist)) 5952 (self-pos (cdr parent))) 5953 (setcdr parent (cons (cons self-heading self-pos) alist))) 5954 (setcdr root alist)) ; primogenitor 5955 (setq cur-alist alist) 5956 (setq cur-level level)) 5957 (t ; new sibling of an ancestor 5958 (let ((sibling-alist (last (cdr root)))) 5959 (dotimes (_ (1- level)) 5960 (setq sibling-alist (last (cdar sibling-alist)))) 5961 (setcdr sibling-alist alist) 5962 (setq cur-alist alist)) 5963 (setq cur-level level))))) 5964 (setq root (copy-tree root)) 5965 ;; Footnotes 5966 (let ((fn (markdown-get-defined-footnotes))) 5967 (if (or (zerop (length fn)) 5968 (null markdown-add-footnotes-to-imenu)) 5969 (cdr root) 5970 (nconc (cdr root) (list (cons "Footnotes" fn)))))))) 5971 5972 (defun markdown-imenu-create-flat-index () 5973 "Create and return a flat imenu index alist for the current buffer. 5974 See `imenu-create-index-function' and `imenu--index-alist' for details." 5975 (let* ((empty-heading "-") index heading pos) 5976 (save-excursion 5977 ;; Headings 5978 (goto-char (point-min)) 5979 (while (re-search-forward markdown-regex-header (point-max) t) 5980 (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) 5981 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) 5982 (cond 5983 ((setq heading (match-string-no-properties 1)) 5984 (setq pos (match-beginning 1))) 5985 ((setq heading (match-string-no-properties 5)) 5986 (setq pos (match-beginning 4)))) 5987 (or (> (length heading) 0) 5988 (setq heading empty-heading)) 5989 (setq index (append index (list (cons heading pos)))))) 5990 ;; Footnotes 5991 (when markdown-add-footnotes-to-imenu 5992 (nconc index (markdown-get-defined-footnotes))) 5993 index))) 5994 5995 5996 ;;; References ================================================================ 5997 5998 (defun markdown-reference-goto-definition () 5999 "Jump to the definition of the reference at point or create it." 6000 (interactive) 6001 (when (thing-at-point-looking-at markdown-regex-link-reference) 6002 (let* ((text (match-string-no-properties 3)) 6003 (reference (match-string-no-properties 6)) 6004 (target (downcase (if (string= reference "") text reference))) 6005 (loc (cadr (save-match-data (markdown-reference-definition target))))) 6006 (if loc 6007 (goto-char loc) 6008 (goto-char (match-beginning 0)) 6009 (markdown-insert-reference-definition target))))) 6010 6011 (defun markdown-reference-find-links (reference) 6012 "Return a list of all links for REFERENCE. 6013 REFERENCE should not include the surrounding square brackets. 6014 Elements of the list have the form (text start line), where 6015 text is the link text, start is the location at the beginning of 6016 the link, and line is the line number on which the link appears." 6017 (let* ((ref-quote (regexp-quote reference)) 6018 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" 6019 ref-quote ref-quote)) 6020 links) 6021 (save-excursion 6022 (goto-char (point-min)) 6023 (while (re-search-forward regexp nil t) 6024 (let* ((text (or (match-string-no-properties 1) 6025 (match-string-no-properties 2))) 6026 (start (match-beginning 0)) 6027 (line (markdown-line-number-at-pos))) 6028 (cl-pushnew (list text start line) links :test #'equal)))) 6029 links)) 6030 6031 (defmacro markdown-for-all-refs (f) 6032 `(let ((result)) 6033 (save-excursion 6034 (goto-char (point-min)) 6035 (while 6036 (re-search-forward markdown-regex-link-reference nil t) 6037 (let* ((text (match-string-no-properties 3)) 6038 (reference (match-string-no-properties 6)) 6039 (target (downcase (if (string= reference "") text reference)))) 6040 (,f text target result)))) 6041 (reverse result))) 6042 6043 (defmacro markdown-collect-always (_ target result) 6044 `(cl-pushnew ,target ,result :test #'equal)) 6045 6046 (defmacro markdown-collect-undefined (text target result) 6047 `(unless (markdown-reference-definition target) 6048 (let ((entry (assoc ,target ,result))) 6049 (if (not entry) 6050 (cl-pushnew 6051 (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) 6052 ,result :test #'equal) 6053 (setcdr entry 6054 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) 6055 6056 (defun markdown-get-all-refs () 6057 "Return a list of all Markdown references." 6058 (markdown-for-all-refs markdown-collect-always)) 6059 6060 (defun markdown-get-undefined-refs () 6061 "Return a list of undefined Markdown references. 6062 Result is an alist of pairs (reference . occurrences), where 6063 occurrences is itself another alist of pairs (label . line-number). 6064 For example, an alist corresponding to [Nice editor][Emacs] at line 12, 6065 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is 6066 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." 6067 (markdown-for-all-refs markdown-collect-undefined)) 6068 6069 (defun markdown-get-unused-refs () 6070 (cl-sort 6071 (cl-set-difference 6072 (markdown-get-defined-references) (markdown-get-all-refs) 6073 :test (lambda (e1 e2) (equal (car e1) e2))) 6074 #'< :key #'cdr)) 6075 6076 (defmacro defun-markdown-buffer (name docstring) 6077 "Define a function to name and return a buffer. 6078 6079 By convention, NAME must be a name of a string constant with 6080 %buffer% placeholder used to name the buffer, and will also be 6081 used as a name of the function defined. 6082 6083 DOCSTRING will be used as the first part of the docstring." 6084 `(defun ,name (&optional buffer-name) 6085 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") 6086 (or buffer-name (setq buffer-name (buffer-name))) 6087 (let ((refbuf (get-buffer-create (replace-regexp-in-string 6088 "%buffer%" buffer-name 6089 ,name)))) 6090 (with-current-buffer refbuf 6091 (when view-mode 6092 (View-exit-and-edit)) 6093 (use-local-map button-buffer-map) 6094 (erase-buffer)) 6095 refbuf))) 6096 6097 (defconst markdown-reference-check-buffer 6098 "*Undefined references for %buffer%*" 6099 "Pattern for name of buffer for listing undefined references. 6100 The string %buffer% will be replaced by the corresponding 6101 `markdown-mode' buffer name.") 6102 6103 (defun-markdown-buffer 6104 markdown-reference-check-buffer 6105 "Name and return buffer for reference checking.") 6106 6107 (defconst markdown-unused-references-buffer 6108 "*Unused references for %buffer%*" 6109 "Pattern for name of buffer for listing unused references. 6110 The string %buffer% will be replaced by the corresponding 6111 `markdown-mode' buffer name.") 6112 6113 (defun-markdown-buffer 6114 markdown-unused-references-buffer 6115 "Name and return buffer for unused reference checking.") 6116 6117 (defconst markdown-reference-links-buffer 6118 "*Reference links for %buffer%*" 6119 "Pattern for name of buffer for listing references. 6120 The string %buffer% will be replaced by the corresponding buffer name.") 6121 6122 (defun-markdown-buffer 6123 markdown-reference-links-buffer 6124 "Name, setup, and return a buffer for listing links.") 6125 6126 ;; Add an empty Markdown reference definition to buffer 6127 ;; specified in the 'target-buffer property. The reference name is 6128 ;; the button's label. 6129 (define-button-type 'markdown-undefined-reference-button 6130 'help-echo "mouse-1, RET: create definition for undefined reference" 6131 'follow-link t 6132 'face 'bold 6133 'action (lambda (b) 6134 (let ((buffer (button-get b 'target-buffer)) 6135 (line (button-get b 'target-line)) 6136 (label (button-label b))) 6137 (switch-to-buffer-other-window buffer) 6138 (goto-char (point-min)) 6139 (forward-line line) 6140 (markdown-insert-reference-definition label) 6141 (markdown-check-refs t)))) 6142 6143 ;; Jump to line in buffer specified by 'target-buffer property. 6144 ;; Line number is button's 'target-line property. 6145 (define-button-type 'markdown-goto-line-button 6146 'help-echo "mouse-1, RET: go to line" 6147 'follow-link t 6148 'face 'italic 6149 'action (lambda (b) 6150 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6151 ;; use call-interactively to silence compiler 6152 (let ((current-prefix-arg (button-get b 'target-line))) 6153 (call-interactively 'goto-line)))) 6154 6155 ;; Kill a line in buffer specified by 'target-buffer property. 6156 ;; Line number is button's 'target-line property. 6157 (define-button-type 'markdown-kill-line-button 6158 'help-echo "mouse-1, RET: kill line" 6159 'follow-link t 6160 'face 'italic 6161 'action (lambda (b) 6162 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6163 ;; use call-interactively to silence compiler 6164 (let ((current-prefix-arg (button-get b 'target-line))) 6165 (call-interactively 'goto-line)) 6166 (kill-line 1) 6167 (markdown-unused-refs t))) 6168 6169 ;; Jumps to a particular link at location given by 'target-char 6170 ;; property in buffer given by 'target-buffer property. 6171 (define-button-type 'markdown-location-button 6172 'help-echo "mouse-1, RET: jump to location of link" 6173 'follow-link t 6174 'face 'bold 6175 'action (lambda (b) 6176 (let ((target (button-get b 'target-buffer)) 6177 (loc (button-get b 'target-char))) 6178 (kill-buffer-and-window) 6179 (switch-to-buffer target) 6180 (goto-char loc)))) 6181 6182 (defun markdown-insert-undefined-reference-button (reference oldbuf) 6183 "Insert a button for creating REFERENCE in buffer OLDBUF. 6184 REFERENCE should be a list of the form (reference . occurrences), 6185 as returned by `markdown-get-undefined-refs'." 6186 (let ((label (car reference))) 6187 ;; Create a reference button 6188 (insert-button label 6189 :type 'markdown-undefined-reference-button 6190 'target-buffer oldbuf 6191 'target-line (cdr (car (cdr reference)))) 6192 (insert " (") 6193 (dolist (occurrence (cdr reference)) 6194 (let ((line (cdr occurrence))) 6195 ;; Create a line number button 6196 (insert-button (number-to-string line) 6197 :type 'markdown-goto-line-button 6198 'target-buffer oldbuf 6199 'target-line line) 6200 (insert " "))) 6201 (delete-char -1) 6202 (insert ")") 6203 (newline))) 6204 6205 (defun markdown-insert-unused-reference-button (reference oldbuf) 6206 "Insert a button for creating REFERENCE in buffer OLDBUF. 6207 REFERENCE must be a pair of (ref . line-number)." 6208 (let ((label (car reference)) 6209 (line (cdr reference))) 6210 ;; Create a reference button 6211 (insert-button label 6212 :type 'markdown-goto-line-button 6213 'face 'bold 6214 'target-buffer oldbuf 6215 'target-line line) 6216 (insert (format " (%d) [" line)) 6217 (insert-button "X" 6218 :type 'markdown-kill-line-button 6219 'face 'bold 6220 'target-buffer oldbuf 6221 'target-line line) 6222 (insert "]") 6223 (newline))) 6224 6225 (defun markdown-insert-link-button (link oldbuf) 6226 "Insert a button for jumping to LINK in buffer OLDBUF. 6227 LINK should be a list of the form (text char line) containing 6228 the link text, location, and line number." 6229 (let ((label (cl-first link)) 6230 (char (cl-second link)) 6231 (line (cl-third link))) 6232 ;; Create a reference button 6233 (insert-button label 6234 :type 'markdown-location-button 6235 'target-buffer oldbuf 6236 'target-char char) 6237 (insert (format " (line %d)\n" line)))) 6238 6239 (defun markdown-reference-goto-link (&optional reference) 6240 "Jump to the location of the first use of REFERENCE." 6241 (interactive) 6242 (unless reference 6243 (if (thing-at-point-looking-at markdown-regex-reference-definition) 6244 (setq reference (match-string-no-properties 2)) 6245 (user-error "No reference definition at point"))) 6246 (let ((links (markdown-reference-find-links reference))) 6247 (cond ((= (length links) 1) 6248 (goto-char (cadr (car links)))) 6249 ((> (length links) 1) 6250 (let ((oldbuf (current-buffer)) 6251 (linkbuf (markdown-reference-links-buffer))) 6252 (with-current-buffer linkbuf 6253 (insert "Links using reference " reference ":\n\n") 6254 (dolist (link (reverse links)) 6255 (markdown-insert-link-button link oldbuf))) 6256 (view-buffer-other-window linkbuf) 6257 (goto-char (point-min)) 6258 (forward-line 2))) 6259 (t 6260 (error "No links for reference %s" reference))))) 6261 6262 (defmacro defun-markdown-ref-checker 6263 (name docstring checker-function buffer-function none-message buffer-header insert-reference) 6264 "Define a function NAME acting on result of CHECKER-FUNCTION. 6265 6266 DOCSTRING is used as a docstring for the defined function. 6267 6268 BUFFER-FUNCTION should name and return an auxiliary buffer to put 6269 results in. 6270 6271 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. 6272 6273 BUFFER-HEADER is put into the auxiliary buffer first, followed by 6274 calling INSERT-REFERENCE for each element in the list returned by 6275 CHECKER-FUNCTION." 6276 `(defun ,name (&optional silent) 6277 ,(concat 6278 docstring 6279 "\n\nIf SILENT is non-nil, do not message anything when no 6280 such references found.") 6281 (interactive "P") 6282 (unless (derived-mode-p 'markdown-mode) 6283 (user-error "Not available in current mode")) 6284 (let ((oldbuf (current-buffer)) 6285 (refs (,checker-function)) 6286 (refbuf (,buffer-function))) 6287 (if (null refs) 6288 (progn 6289 (when (not silent) 6290 (message ,none-message)) 6291 (kill-buffer refbuf)) 6292 (with-current-buffer refbuf 6293 (insert ,buffer-header) 6294 (dolist (ref refs) 6295 (,insert-reference ref oldbuf)) 6296 (view-buffer-other-window refbuf) 6297 (goto-char (point-min)) 6298 (forward-line 2)))))) 6299 6300 (defun-markdown-ref-checker 6301 markdown-check-refs 6302 "Show all undefined Markdown references in current `markdown-mode' buffer. 6303 6304 Links which have empty reference definitions are considered to be 6305 defined." 6306 markdown-get-undefined-refs 6307 markdown-reference-check-buffer 6308 "No undefined references found" 6309 "The following references are undefined:\n\n" 6310 markdown-insert-undefined-reference-button) 6311 6312 6313 (defun-markdown-ref-checker 6314 markdown-unused-refs 6315 "Show all unused Markdown references in current `markdown-mode' buffer." 6316 markdown-get-unused-refs 6317 markdown-unused-references-buffer 6318 "No unused references found" 6319 "The following references are unused:\n\n" 6320 markdown-insert-unused-reference-button) 6321 6322 6323 6324 ;;; Lists ===================================================================== 6325 6326 (defun markdown-insert-list-item (&optional arg) 6327 "Insert a new list item. 6328 If the point is inside unordered list, insert a bullet mark. If 6329 the point is inside ordered list, insert the next number followed 6330 by a period. Use the previous list item to determine the amount 6331 of whitespace to place before and after list markers. 6332 6333 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 6334 decrease the indentation by one level. 6335 6336 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 6337 increase the indentation by one level." 6338 (interactive "p") 6339 (let (bounds cur-indent marker indent new-indent new-loc) 6340 (save-match-data 6341 ;; Look for a list item on current or previous non-blank line 6342 (save-excursion 6343 (while (and (not (setq bounds (markdown-cur-list-item-bounds))) 6344 (not (bobp)) 6345 (markdown-cur-line-blank-p)) 6346 (forward-line -1))) 6347 (when bounds 6348 (cond ((save-excursion 6349 (skip-chars-backward " \t") 6350 (looking-at-p markdown-regex-list)) 6351 (beginning-of-line) 6352 (insert "\n") 6353 (forward-line -1)) 6354 ((not (markdown-cur-line-blank-p)) 6355 (newline))) 6356 (setq new-loc (point))) 6357 ;; Look ahead for a list item on next non-blank line 6358 (unless bounds 6359 (save-excursion 6360 (while (and (null bounds) 6361 (not (eobp)) 6362 (markdown-cur-line-blank-p)) 6363 (forward-line) 6364 (setq bounds (markdown-cur-list-item-bounds)))) 6365 (when bounds 6366 (setq new-loc (point)) 6367 (unless (markdown-cur-line-blank-p) 6368 (newline)))) 6369 (if (not bounds) 6370 ;; When not in a list, start a new unordered one 6371 (progn 6372 (unless (markdown-cur-line-blank-p) 6373 (insert "\n")) 6374 (insert markdown-unordered-list-item-prefix)) 6375 ;; Compute indentation and marker for new list item 6376 (setq cur-indent (nth 2 bounds)) 6377 (setq marker (nth 4 bounds)) 6378 ;; If current item is a GFM checkbox, insert new unchecked checkbox. 6379 (when (nth 5 bounds) 6380 (setq marker 6381 (concat marker 6382 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) 6383 (cond 6384 ;; Dedent: decrement indentation, find previous marker. 6385 ((= arg 4) 6386 (setq indent (max (- cur-indent markdown-list-indent-width) 0)) 6387 (let ((prev-bounds 6388 (save-excursion 6389 (goto-char (nth 0 bounds)) 6390 (when (markdown-up-list) 6391 (markdown-cur-list-item-bounds))))) 6392 (when prev-bounds 6393 (setq marker (nth 4 prev-bounds))))) 6394 ;; Indent: increment indentation by 4, use same marker. 6395 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) 6396 ;; Same level: keep current indentation and marker. 6397 (t (setq indent cur-indent))) 6398 (setq new-indent (make-string indent 32)) 6399 (goto-char new-loc) 6400 (cond 6401 ;; Ordered list 6402 ((string-match-p "[0-9]" marker) 6403 (if (= arg 16) ;; starting a new column indented one more level 6404 (insert (concat new-indent "1. ")) 6405 ;; Don't use previous match-data 6406 (set-match-data nil) 6407 ;; travel up to the last item and pick the correct number. If 6408 ;; the argument was nil, "new-indent = cur-indent" is the same, 6409 ;; so we don't need special treatment. Neat. 6410 (save-excursion 6411 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) 6412 (>= (forward-line -1) 0)))) 6413 (let* ((old-prefix (match-string 1)) 6414 (old-spacing (match-string 2)) 6415 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) 6416 (int-to-string (1+ (string-to-number old-prefix))) 6417 "1")) 6418 (space-adjust (- (length old-prefix) (length new-prefix))) 6419 (new-spacing (if (and (match-string 2) 6420 (not (string-match-p "\t" old-spacing)) 6421 (< space-adjust 0) 6422 (> space-adjust (- 1 (length (match-string 2))))) 6423 (substring (match-string 2) 0 space-adjust) 6424 (or old-spacing ". ")))) 6425 (insert (concat new-indent new-prefix new-spacing))))) 6426 ;; Unordered list, GFM task list, or ordered list with hash mark 6427 ((string-match-p "[\\*\\+-]\\|#\\." marker) 6428 (insert new-indent marker)))) 6429 ;; Propertize the newly inserted list item now 6430 (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) 6431 6432 (defun markdown-move-list-item-up () 6433 "Move the current list item up in the list when possible. 6434 In nested lists, move child items with the parent item." 6435 (interactive) 6436 (let (cur prev old) 6437 (when (setq cur (markdown-cur-list-item-bounds)) 6438 (setq old (point)) 6439 (goto-char (nth 0 cur)) 6440 (if (markdown-prev-list-item (nth 3 cur)) 6441 (progn 6442 (setq prev (markdown-cur-list-item-bounds)) 6443 (condition-case nil 6444 (progn 6445 (transpose-regions (nth 0 prev) (nth 1 prev) 6446 (nth 0 cur) (nth 1 cur) t) 6447 (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) 6448 ;; Catch error in case regions overlap. 6449 (error (goto-char old)))) 6450 (goto-char old))))) 6451 6452 (defun markdown-move-list-item-down () 6453 "Move the current list item down in the list when possible. 6454 In nested lists, move child items with the parent item." 6455 (interactive) 6456 (let (cur next old) 6457 (when (setq cur (markdown-cur-list-item-bounds)) 6458 (setq old (point)) 6459 (if (markdown-next-list-item (nth 3 cur)) 6460 (progn 6461 (setq next (markdown-cur-list-item-bounds)) 6462 (condition-case nil 6463 (progn 6464 (transpose-regions (nth 0 cur) (nth 1 cur) 6465 (nth 0 next) (nth 1 next) nil) 6466 (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) 6467 ;; Catch error in case regions overlap. 6468 (error (goto-char old)))) 6469 (goto-char old))))) 6470 6471 (defun markdown-demote-list-item (&optional bounds) 6472 "Indent (or demote) the current list item. 6473 Optionally, BOUNDS of the current list item may be provided if available. 6474 In nested lists, demote child items as well." 6475 (interactive) 6476 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6477 (save-excursion 6478 (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) 6479 (item-end (set-marker (make-marker) (nth 1 bounds))) 6480 (list-start (progn (markdown-beginning-of-list) 6481 (set-marker (make-marker) (point)))) 6482 (list-end (progn (markdown-end-of-list) 6483 (set-marker (make-marker) (point))))) 6484 (goto-char item-start) 6485 (while (< (point) item-end) 6486 (unless (markdown-cur-line-blank-p) 6487 (insert (make-string markdown-list-indent-width ? ))) 6488 (forward-line)) 6489 (markdown-syntax-propertize-list-items list-start list-end))))) 6490 6491 (defun markdown-promote-list-item (&optional bounds) 6492 "Unindent (or promote) the current list item. 6493 Optionally, BOUNDS of the current list item may be provided if available. 6494 In nested lists, demote child items as well." 6495 (interactive) 6496 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6497 (save-excursion 6498 (save-match-data 6499 (let ((item-start (set-marker (make-marker) (nth 0 bounds))) 6500 (item-end (set-marker (make-marker) (nth 1 bounds))) 6501 (list-start (progn (markdown-beginning-of-list) 6502 (set-marker (make-marker) (point)))) 6503 (list-end (progn (markdown-end-of-list) 6504 (set-marker (make-marker) (point)))) 6505 num regexp) 6506 (goto-char item-start) 6507 (when (looking-at (format "^[ ]\\{1,%d\\}" 6508 markdown-list-indent-width)) 6509 (setq num (- (match-end 0) (match-beginning 0))) 6510 (setq regexp (format "^[ ]\\{1,%d\\}" num)) 6511 (while (and (< (point) item-end) 6512 (re-search-forward regexp item-end t)) 6513 (replace-match "" nil nil) 6514 (forward-line)) 6515 (markdown-syntax-propertize-list-items list-start list-end))))))) 6516 6517 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) 6518 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. 6519 PREV-ITEM is width of previous-indentation and list number 6520 6521 Assume that the previously found match was for a numbered item in 6522 a list." 6523 (let ((cpfx pfx) 6524 (cur-item nil) 6525 (idx 0) 6526 (continue t) 6527 (step t) 6528 (sep nil)) 6529 (while (and continue (not (eobp))) 6530 (setq step t) 6531 (cond 6532 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") 6533 (setq cpfx (match-string-no-properties 2)) 6534 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker 6535 (cond 6536 ((or (= (length cpfx) (length pfx)) 6537 (= (length cur-item) (length prev-item))) 6538 (save-excursion 6539 (replace-match 6540 (if (not markdown-ordered-list-enumeration) 6541 (concat pfx "1. ") 6542 (cl-incf idx) 6543 (concat pfx (number-to-string idx) ". ")))) 6544 (setq sep nil)) 6545 ;; indented a level 6546 ((< (length pfx) (length cpfx)) 6547 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) 6548 (setq step nil)) 6549 ;; exit the loop 6550 (t 6551 (setq step nil) 6552 (setq continue nil)))) 6553 6554 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") 6555 (setq cpfx (match-string-no-properties 1)) 6556 (cond 6557 ;; reset if separated before 6558 ((string= cpfx pfx) (when sep (setq idx 0))) 6559 ((string< cpfx pfx) 6560 (setq step nil) 6561 (setq continue nil)))) 6562 (t (setq sep t))) 6563 6564 (when step 6565 (beginning-of-line) 6566 (setq continue (= (forward-line) 0)))) 6567 sep)) 6568 6569 (defun markdown-cleanup-list-numbers () 6570 "Update the numbering of ordered lists." 6571 (interactive) 6572 (save-excursion 6573 (goto-char (point-min)) 6574 (markdown-cleanup-list-numbers-level ""))) 6575 6576 6577 ;;; Movement ================================================================== 6578 6579 ;; This function was originally derived from `org-beginning-of-line' from org.el. 6580 (defun markdown-beginning-of-line (&optional n) 6581 "Go to the beginning of the current visible line. 6582 6583 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6584 or symbol `reversed', on the first attempt move to where the 6585 headline text hashes, and only move to beginning of line when the 6586 cursor is already before the hashes of the text of the headline. 6587 6588 If `markdown-special-ctrl-a/e' is symbol `reversed' then go to 6589 the hashes of the text on the second attempt. 6590 6591 With argument N not nil or 1, move forward N - 1 lines first." 6592 (interactive "^p") 6593 (let ((origin (point)) 6594 (special (pcase markdown-special-ctrl-a/e 6595 (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) 6596 deactivate-mark) 6597 ;; First move to a visible line. 6598 (if visual-line-mode 6599 (beginning-of-visual-line n) 6600 (move-beginning-of-line n) 6601 ;; `move-beginning-of-line' may leave point after invisible 6602 ;; characters if line starts with such of these (e.g., with 6603 ;; a link at column 0). Really move to the beginning of the 6604 ;; current visible line. 6605 (forward-line 0)) 6606 (cond 6607 ;; No special behavior. Point is already at the beginning of 6608 ;; a line, logical or visual. 6609 ((not special)) 6610 ;; `beginning-of-visual-line' left point before logical beginning 6611 ;; of line: point is at the beginning of a visual line. Bail 6612 ;; out. 6613 ((and visual-line-mode (not (bolp)))) 6614 ((looking-at markdown-regex-header-atx) 6615 ;; At a header, special position is before the title. 6616 (let ((refpos (match-beginning 2)) 6617 (bol (point))) 6618 (if (eq special 'reversed) 6619 (when (and (= origin bol) (eq last-command this-command)) 6620 (goto-char refpos)) 6621 (when (or (> origin refpos) (<= origin bol)) 6622 (goto-char refpos))) 6623 ;; Prevent automatic cursor movement caused by the command loop. 6624 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6625 (when (and markdown-hide-markup 6626 (equal (get-char-property (point) 'display) "")) 6627 (setq disable-point-adjustment t)))) 6628 ((looking-at markdown-regex-list) 6629 ;; At a list item, special position is after the list marker or checkbox. 6630 (let ((refpos (or (match-end 4) (match-end 3)))) 6631 (if (eq special 'reversed) 6632 (when (and (= (point) origin) (eq last-command this-command)) 6633 (goto-char refpos)) 6634 (when (or (> origin refpos) (<= origin (line-beginning-position))) 6635 (goto-char refpos))))) 6636 ;; No special case, already at beginning of line. 6637 (t nil)))) 6638 6639 ;; This function was originally derived from `org-end-of-line' from org.el. 6640 (defun markdown-end-of-line (&optional n) 6641 "Go to the end of the line, but before ellipsis, if any. 6642 6643 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6644 or symbol `reversed', ignore closing tags on the first attempt, 6645 and only move to after the closing tags when the cursor is 6646 already beyond the end of the headline. 6647 6648 If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore 6649 closing tags on the second attempt. 6650 6651 With argument N not nil or 1, move forward N - 1 lines first." 6652 (interactive "^p") 6653 (let ((origin (point)) 6654 (special (pcase markdown-special-ctrl-a/e 6655 (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) 6656 deactivate-mark) 6657 ;; First move to a visible line. 6658 (if visual-line-mode 6659 (beginning-of-visual-line n) 6660 (move-beginning-of-line n)) 6661 (cond 6662 ;; At a headline, with closing tags. 6663 ((save-excursion 6664 (forward-line 0) 6665 (and (looking-at markdown-regex-header-atx) (match-end 3))) 6666 (let ((refpos (match-end 2)) 6667 (visual-end (and visual-line-mode 6668 (save-excursion 6669 (end-of-visual-line) 6670 (point))))) 6671 ;; If `end-of-visual-line' brings us before end of line or even closing 6672 ;; tags, i.e., the headline spans over multiple visual lines, move 6673 ;; there. 6674 (cond ((and visual-end 6675 (< visual-end refpos) 6676 (<= origin visual-end)) 6677 (goto-char visual-end)) 6678 ((not special) (end-of-line)) 6679 ((eq special 'reversed) 6680 (if (and (= origin (line-end-position)) 6681 (eq this-command last-command)) 6682 (goto-char refpos) 6683 (end-of-line))) 6684 (t 6685 (if (or (< origin refpos) (>= origin (line-end-position))) 6686 (goto-char refpos) 6687 (end-of-line)))) 6688 ;; Prevent automatic cursor movement caused by the command loop. 6689 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6690 (when (and markdown-hide-markup 6691 (equal (get-char-property (point) 'display) "")) 6692 (setq disable-point-adjustment t)))) 6693 (visual-line-mode 6694 (let ((bol (line-beginning-position))) 6695 (end-of-visual-line) 6696 ;; If `end-of-visual-line' gets us past the ellipsis at the 6697 ;; end of a line, backtrack and use `end-of-line' instead. 6698 (when (/= bol (line-beginning-position)) 6699 (goto-char bol) 6700 (end-of-line)))) 6701 (t (end-of-line))))) 6702 6703 (defun markdown-beginning-of-defun (&optional arg) 6704 "`beginning-of-defun-function' for Markdown. 6705 This is used to find the beginning of the defun and should behave 6706 like ‘beginning-of-defun’, returning non-nil if it found the 6707 beginning of a defun. It moves the point backward, right before a 6708 heading which defines a defun. When ARG is non-nil, repeat that 6709 many times. When ARG is negative, move forward to the ARG-th 6710 following section." 6711 (or arg (setq arg 1)) 6712 (when (< arg 0) (end-of-line)) 6713 ;; Adjust position for setext headings. 6714 (when (and (thing-at-point-looking-at markdown-regex-header-setext) 6715 (not (= (point) (match-beginning 0))) 6716 (not (markdown-code-block-at-point-p))) 6717 (goto-char (match-end 0))) 6718 (let (found) 6719 ;; Move backward with positive argument. 6720 (while (and (not (bobp)) (> arg 0)) 6721 (setq found nil) 6722 (while (and (not found) 6723 (not (bobp)) 6724 (re-search-backward markdown-regex-header nil 'move)) 6725 (markdown-code-block-at-pos (match-beginning 0)) 6726 (setq found (match-beginning 0))) 6727 (setq arg (1- arg))) 6728 ;; Move forward with negative argument. 6729 (while (and (not (eobp)) (< arg 0)) 6730 (setq found nil) 6731 (while (and (not found) 6732 (not (eobp)) 6733 (re-search-forward markdown-regex-header nil 'move)) 6734 (markdown-code-block-at-pos (match-beginning 0)) 6735 (setq found (match-beginning 0))) 6736 (setq arg (1+ arg))) 6737 (when found 6738 (beginning-of-line) 6739 t))) 6740 6741 (defun markdown-end-of-defun () 6742 "`end-of-defun-function’ for Markdown. 6743 This is used to find the end of the defun at point. 6744 It is called with no argument, right after calling ‘beginning-of-defun-raw’, 6745 so it can assume that point is at the beginning of the defun body. 6746 It should move point to the first position after the defun." 6747 (or (eobp) (forward-char 1)) 6748 (let (found) 6749 (while (and (not found) 6750 (not (eobp)) 6751 (re-search-forward markdown-regex-header nil 'move)) 6752 (when (not (markdown-code-block-at-pos (match-beginning 0))) 6753 (setq found (match-beginning 0)))) 6754 (when found 6755 (goto-char found) 6756 (skip-syntax-backward "-")))) 6757 6758 (defun markdown-beginning-of-text-block () 6759 "Move backward to previous beginning of a plain text block. 6760 This function simply looks for blank lines without considering 6761 the surrounding context in light of Markdown syntax. For that, see 6762 `markdown-backward-block'." 6763 (interactive) 6764 (let ((start (point))) 6765 (if (re-search-backward markdown-regex-block-separator nil t) 6766 (goto-char (match-end 0)) 6767 (goto-char (point-min))) 6768 (when (and (= start (point)) (not (bobp))) 6769 (forward-line -1) 6770 (if (re-search-backward markdown-regex-block-separator nil t) 6771 (goto-char (match-end 0)) 6772 (goto-char (point-min)))))) 6773 6774 (defun markdown-end-of-text-block () 6775 "Move forward to next beginning of a plain text block. 6776 This function simply looks for blank lines without considering 6777 the surrounding context in light of Markdown syntax. For that, see 6778 `markdown-forward-block'." 6779 (interactive) 6780 (beginning-of-line) 6781 (skip-chars-forward " \t\n") 6782 (when (= (point) (point-min)) 6783 (forward-char)) 6784 (if (re-search-forward markdown-regex-block-separator nil t) 6785 (goto-char (match-end 0)) 6786 (goto-char (point-max))) 6787 (skip-chars-backward " \t\n") 6788 (forward-line)) 6789 6790 (defun markdown-backward-paragraph (&optional arg) 6791 "Move the point to the start of the current paragraph. 6792 With argument ARG, do it ARG times; a negative argument ARG = -N 6793 means move forward N blocks." 6794 (interactive "^p") 6795 (or arg (setq arg 1)) 6796 (if (< arg 0) 6797 (markdown-forward-paragraph (- arg)) 6798 (dotimes (_ arg) 6799 ;; Skip over whitespace in between paragraphs when moving backward. 6800 (skip-chars-backward " \t\n") 6801 (beginning-of-line) 6802 ;; Skip over code block endings. 6803 (when (markdown-range-properties-exist 6804 (line-beginning-position) (line-end-position) 6805 '(markdown-gfm-block-end 6806 markdown-tilde-fence-end)) 6807 (forward-line -1)) 6808 ;; Skip over blank lines inside blockquotes. 6809 (while (and (not (eobp)) 6810 (looking-at markdown-regex-blockquote) 6811 (= (length (match-string 3)) 0)) 6812 (forward-line -1)) 6813 ;; Proceed forward based on the type of block of paragraph. 6814 (let (bounds skip) 6815 (cond 6816 ;; Blockquotes 6817 ((looking-at markdown-regex-blockquote) 6818 (while (and (not (bobp)) 6819 (looking-at markdown-regex-blockquote) 6820 (> (length (match-string 3)) 0)) ;; not blank 6821 (forward-line -1)) 6822 (forward-line)) 6823 ;; List items 6824 ((setq bounds (markdown-cur-list-item-bounds)) 6825 (goto-char (nth 0 bounds))) 6826 ;; Other 6827 (t 6828 (while (and (not (bobp)) 6829 (not skip) 6830 (not (markdown-cur-line-blank-p)) 6831 (not (looking-at markdown-regex-blockquote)) 6832 (not (markdown-range-properties-exist 6833 (line-beginning-position) (line-end-position) 6834 '(markdown-gfm-block-end 6835 markdown-tilde-fence-end)))) 6836 (setq skip (markdown-range-properties-exist 6837 (line-beginning-position) (line-end-position) 6838 '(markdown-gfm-block-begin 6839 markdown-tilde-fence-begin))) 6840 (forward-line -1)) 6841 (unless (bobp) 6842 (forward-line 1)))))))) 6843 6844 (defun markdown-forward-paragraph (&optional arg) 6845 "Move forward to the next end of a paragraph. 6846 With argument ARG, do it ARG times; a negative argument ARG = -N 6847 means move backward N blocks." 6848 (interactive "^p") 6849 (or arg (setq arg 1)) 6850 (if (< arg 0) 6851 (markdown-backward-paragraph (- arg)) 6852 (dotimes (_ arg) 6853 ;; Skip whitespace in between paragraphs. 6854 (when (markdown-cur-line-blank-p) 6855 (skip-syntax-forward "-") 6856 (beginning-of-line)) 6857 ;; Proceed forward based on the type of block. 6858 (let (bounds skip) 6859 (cond 6860 ;; Blockquotes 6861 ((looking-at markdown-regex-blockquote) 6862 ;; Skip over blank lines inside blockquotes. 6863 (while (and (not (eobp)) 6864 (looking-at markdown-regex-blockquote) 6865 (= (length (match-string 3)) 0)) 6866 (forward-line)) 6867 ;; Move to end of quoted text block 6868 (while (and (not (eobp)) 6869 (looking-at markdown-regex-blockquote) 6870 (> (length (match-string 3)) 0)) ;; not blank 6871 (forward-line))) 6872 ;; List items 6873 ((and (markdown-cur-list-item-bounds) 6874 (setq bounds (markdown-next-list-item-bounds))) 6875 (goto-char (nth 0 bounds))) 6876 ;; Other 6877 (t 6878 (forward-line) 6879 (while (and (not (eobp)) 6880 (not skip) 6881 (not (markdown-cur-line-blank-p)) 6882 (not (looking-at markdown-regex-blockquote)) 6883 (not (markdown-range-properties-exist 6884 (line-beginning-position) (line-end-position) 6885 '(markdown-gfm-block-begin 6886 markdown-tilde-fence-begin)))) 6887 (setq skip (markdown-range-properties-exist 6888 (line-beginning-position) (line-end-position) 6889 '(markdown-gfm-block-end 6890 markdown-tilde-fence-end))) 6891 (forward-line)))))))) 6892 6893 (defun markdown-backward-block (&optional arg) 6894 "Move the point to the start of the current Markdown block. 6895 Moves across complete code blocks, list items, and blockquotes, 6896 but otherwise stops at blank lines, headers, and horizontal 6897 rules. With argument ARG, do it ARG times; a negative argument 6898 ARG = -N means move forward N blocks." 6899 (interactive "^p") 6900 (or arg (setq arg 1)) 6901 (if (< arg 0) 6902 (markdown-forward-block (- arg)) 6903 (dotimes (_ arg) 6904 ;; Skip over whitespace in between blocks when moving backward, 6905 ;; unless at a block boundary with no whitespace. 6906 (skip-syntax-backward "-") 6907 (beginning-of-line) 6908 ;; Proceed forward based on the type of block. 6909 (cond 6910 ;; Code blocks 6911 ((and (markdown-code-block-at-pos (point)) ;; this line 6912 (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line 6913 (forward-line -1) 6914 (while (and (markdown-code-block-at-point-p) (not (bobp))) 6915 (forward-line -1)) 6916 (forward-line)) 6917 ;; Headings 6918 ((markdown-heading-at-point) 6919 (goto-char (match-beginning 0))) 6920 ;; Horizontal rules 6921 ((looking-at markdown-regex-hr)) 6922 ;; Blockquotes 6923 ((looking-at markdown-regex-blockquote) 6924 (forward-line -1) 6925 (while (and (looking-at markdown-regex-blockquote) 6926 (not (bobp))) 6927 (forward-line -1)) 6928 (forward-line)) 6929 ;; List items 6930 ((markdown-cur-list-item-bounds) 6931 (markdown-beginning-of-list)) 6932 ;; Other 6933 (t 6934 ;; Move forward in case it is a one line regular paragraph. 6935 (unless (markdown-next-line-blank-p) 6936 (forward-line)) 6937 (unless (markdown-prev-line-blank-p) 6938 (markdown-backward-paragraph))))))) 6939 6940 (defun markdown-forward-block (&optional arg) 6941 "Move forward to the next end of a Markdown block. 6942 Moves across complete code blocks, list items, and blockquotes, 6943 but otherwise stops at blank lines, headers, and horizontal 6944 rules. With argument ARG, do it ARG times; a negative argument 6945 ARG = -N means move backward N blocks." 6946 (interactive "^p") 6947 (or arg (setq arg 1)) 6948 (if (< arg 0) 6949 (markdown-backward-block (- arg)) 6950 (dotimes (_ arg) 6951 ;; Skip over whitespace in between blocks when moving forward. 6952 (if (markdown-cur-line-blank-p) 6953 (skip-syntax-forward "-") 6954 (beginning-of-line)) 6955 ;; Proceed forward based on the type of block. 6956 (cond 6957 ;; Code blocks 6958 ((markdown-code-block-at-point-p) 6959 (forward-line) 6960 (while (and (markdown-code-block-at-point-p) (not (eobp))) 6961 (forward-line))) 6962 ;; Headings 6963 ((looking-at markdown-regex-header) 6964 (goto-char (or (match-end 4) (match-end 2) (match-end 3))) 6965 (forward-line)) 6966 ;; Horizontal rules 6967 ((looking-at markdown-regex-hr) 6968 (forward-line)) 6969 ;; Blockquotes 6970 ((looking-at markdown-regex-blockquote) 6971 (forward-line) 6972 (while (and (looking-at markdown-regex-blockquote) (not (eobp))) 6973 (forward-line))) 6974 ;; List items 6975 ((markdown-cur-list-item-bounds) 6976 (markdown-end-of-list) 6977 (forward-line)) 6978 ;; Other 6979 (t (markdown-forward-paragraph)))) 6980 (skip-syntax-backward "-") 6981 (unless (eobp) 6982 (forward-char 1)))) 6983 6984 (defun markdown-backward-page (&optional count) 6985 "Move backward to boundary of the current toplevel section. 6986 With COUNT, repeat, or go forward if negative." 6987 (interactive "p") 6988 (or count (setq count 1)) 6989 (if (< count 0) 6990 (markdown-forward-page (- count)) 6991 (skip-syntax-backward "-") 6992 (or (markdown-back-to-heading-over-code-block t t) 6993 (goto-char (point-min))) 6994 (when (looking-at markdown-regex-header) 6995 (let ((level (markdown-outline-level))) 6996 (when (> level 1) (markdown-up-heading level)) 6997 (when (> count 1) 6998 (condition-case nil 6999 (markdown-backward-same-level (1- count)) 7000 (error (goto-char (point-min))))))))) 7001 7002 (defun markdown-forward-page (&optional count) 7003 "Move forward to boundary of the current toplevel section. 7004 With COUNT, repeat, or go backward if negative." 7005 (interactive "p") 7006 (or count (setq count 1)) 7007 (if (< count 0) 7008 (markdown-backward-page (- count)) 7009 (if (markdown-back-to-heading-over-code-block t t) 7010 (let ((level (markdown-outline-level))) 7011 (when (> level 1) (markdown-up-heading level)) 7012 (condition-case nil 7013 (markdown-forward-same-level count) 7014 (error (goto-char (point-max))))) 7015 (markdown-next-visible-heading 1)))) 7016 7017 (defun markdown-next-link () 7018 "Jump to next inline, reference, or wiki link. 7019 If successful, return point. Otherwise, return nil. 7020 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." 7021 (interactive) 7022 (let ((opoint (point))) 7023 (when (or (markdown-link-p) (markdown-wiki-link-p)) 7024 ;; At a link already, move past it. 7025 (goto-char (+ (match-end 0) 1))) 7026 ;; Search for the next wiki link and move to the beginning. 7027 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) 7028 (markdown-code-block-at-point-p) 7029 (< (point) (point-max)))) 7030 (if (and (not (eq (point) opoint)) 7031 (or (markdown-link-p) (markdown-wiki-link-p))) 7032 ;; Group 1 will move past non-escape character in wiki link regexp. 7033 ;; Go to beginning of group zero for all other link types. 7034 (goto-char (or (match-beginning 1) (match-beginning 0))) 7035 (goto-char opoint) 7036 nil))) 7037 7038 (defun markdown-previous-link () 7039 "Jump to previous wiki link. 7040 If successful, return point. Otherwise, return nil. 7041 See `markdown-wiki-link-p' and `markdown-next-wiki-link'." 7042 (interactive) 7043 (let ((opoint (point))) 7044 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) 7045 (markdown-code-block-at-point-p) 7046 (> (point) (point-min)))) 7047 (if (and (not (eq (point) opoint)) 7048 (or (markdown-link-p) (markdown-wiki-link-p))) 7049 (goto-char (or (match-beginning 1) (match-beginning 0))) 7050 (goto-char opoint) 7051 nil))) 7052 7053 7054 ;;; Outline =================================================================== 7055 7056 (defun markdown-move-heading-common (move-fn &optional arg adjust) 7057 "Wrapper for `outline-mode' functions to skip false positives. 7058 MOVE-FN is a function and ARG is its argument. For example, 7059 headings inside preformatted code blocks may match 7060 `outline-regexp' but should not be considered as headings. 7061 When ADJUST is non-nil, adjust the point for interactive calls 7062 to avoid leaving the point at invisible markup. This adjustment 7063 generally should only be done for interactive calls, since other 7064 functions may expect the point to be at the beginning of the 7065 regular expression." 7066 (let ((prev -1) (start (point))) 7067 (if arg (funcall move-fn arg) (funcall move-fn)) 7068 (while (and (/= prev (point)) (markdown-code-block-at-point-p)) 7069 (setq prev (point)) 7070 (if arg (funcall move-fn arg) (funcall move-fn))) 7071 ;; Adjust point for setext headings and invisible text. 7072 (save-match-data 7073 (when (and adjust (thing-at-point-looking-at markdown-regex-header)) 7074 (if markdown-hide-markup 7075 ;; Move to beginning of heading text if markup is hidden. 7076 (goto-char (or (match-beginning 1) (match-beginning 5))) 7077 ;; Move to beginning of markup otherwise. 7078 (goto-char (or (match-beginning 1) (match-beginning 4)))))) 7079 (if (= (point) start) nil (point)))) 7080 7081 (defun markdown-next-visible-heading (arg) 7082 "Move to the next visible heading line of any level. 7083 With argument, repeats or can move backward if negative. ARG is 7084 passed to `outline-next-visible-heading'." 7085 (interactive "p") 7086 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) 7087 7088 (defun markdown-previous-visible-heading (arg) 7089 "Move to the previous visible heading line of any level. 7090 With argument, repeats or can move backward if negative. ARG is 7091 passed to `outline-previous-visible-heading'." 7092 (interactive "p") 7093 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) 7094 7095 (defun markdown-next-heading () 7096 "Move to the next heading line of any level." 7097 (markdown-move-heading-common #'outline-next-heading)) 7098 7099 (defun markdown-previous-heading () 7100 "Move to the previous heading line of any level." 7101 (markdown-move-heading-common #'outline-previous-heading)) 7102 7103 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) 7104 "Move back to the beginning of the previous heading. 7105 Returns t if the point is at a heading, the location if a heading 7106 was found, and nil otherwise. 7107 Only visible heading lines are considered, unless INVISIBLE-OK is 7108 non-nil. Throw an error if there is no previous heading unless 7109 NO-ERROR is non-nil. 7110 Leaves match data intact for `markdown-regex-header'." 7111 (beginning-of-line) 7112 (or (and (markdown-heading-at-point) 7113 (not (markdown-code-block-at-point-p))) 7114 (let (found) 7115 (save-excursion 7116 (while (and (not found) 7117 (re-search-backward markdown-regex-header nil t)) 7118 (when (and (or invisible-ok (not (outline-invisible-p))) 7119 (not (markdown-code-block-at-point-p))) 7120 (setq found (point)))) 7121 (if (not found) 7122 (unless no-error (user-error "Before first heading")) 7123 (setq found (point)))) 7124 (when found (goto-char found))))) 7125 7126 (defun markdown-forward-same-level (arg) 7127 "Move forward to the ARG'th heading at same level as this one. 7128 Stop at the first and last headings of a superior heading." 7129 (interactive "p") 7130 (markdown-back-to-heading-over-code-block) 7131 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) 7132 7133 (defun markdown-backward-same-level (arg) 7134 "Move backward to the ARG'th heading at same level as this one. 7135 Stop at the first and last headings of a superior heading." 7136 (interactive "p") 7137 (markdown-back-to-heading-over-code-block) 7138 (while (> arg 0) 7139 (let ((point-to-move-to 7140 (save-excursion 7141 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) 7142 (if point-to-move-to 7143 (progn 7144 (goto-char point-to-move-to) 7145 (setq arg (1- arg))) 7146 (user-error "No previous same-level heading"))))) 7147 7148 (defun markdown-up-heading (arg &optional interactive) 7149 "Move to the visible heading line of which the present line is a subheading. 7150 With argument, move up ARG levels. When called interactively (or 7151 INTERACTIVE is non-nil), also push the mark." 7152 (interactive "p\np") 7153 (and interactive (not (eq last-command 'markdown-up-heading)) 7154 (push-mark)) 7155 (markdown-move-heading-common #'outline-up-heading arg 'adjust)) 7156 7157 (defun markdown-back-to-heading (&optional invisible-ok) 7158 "Move to previous heading line, or beg of this line if it's a heading. 7159 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 7160 (interactive) 7161 (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) 7162 7163 (defalias 'markdown-end-of-heading 'outline-end-of-heading) 7164 7165 (defun markdown-on-heading-p () 7166 "Return non-nil if point is on a heading line." 7167 (get-text-property (line-beginning-position) 'markdown-heading)) 7168 7169 (defun markdown-end-of-subtree (&optional invisible-OK) 7170 "Move to the end of the current subtree. 7171 Only visible heading lines are considered, unless INVISIBLE-OK is 7172 non-nil. 7173 Derived from `org-end-of-subtree'." 7174 (markdown-back-to-heading invisible-OK) 7175 (let ((first t) 7176 (level (markdown-outline-level))) 7177 (while (and (not (eobp)) 7178 (or first (> (markdown-outline-level) level))) 7179 (setq first nil) 7180 (markdown-next-heading)) 7181 (if (memq (preceding-char) '(?\n ?\^M)) 7182 (progn 7183 ;; Go to end of line before heading 7184 (forward-char -1) 7185 (if (memq (preceding-char) '(?\n ?\^M)) 7186 ;; leave blank line before heading 7187 (forward-char -1))))) 7188 (point)) 7189 7190 (defun markdown-outline-fix-visibility () 7191 "Hide any false positive headings that should not be shown. 7192 For example, headings inside preformatted code blocks may match 7193 `outline-regexp' but should not be shown as headings when cycling. 7194 Also, the ending --- line in metadata blocks appears to be a 7195 setext header, but should not be folded." 7196 (save-excursion 7197 (goto-char (point-min)) 7198 ;; Unhide any false positives in metadata blocks 7199 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) 7200 (let ((body (progn (forward-line) 7201 (markdown-text-property-at-point 7202 'markdown-yaml-metadata-section)))) 7203 (when body 7204 (let ((end (progn (goto-char (cl-second body)) 7205 (markdown-text-property-at-point 7206 'markdown-yaml-metadata-end)))) 7207 (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) 7208 ;; Hide any false positives in code blocks 7209 (unless (outline-on-heading-p) 7210 (outline-next-visible-heading 1)) 7211 (while (< (point) (point-max)) 7212 (when (markdown-code-block-at-point-p) 7213 (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) 7214 (outline-next-visible-heading 1)))) 7215 7216 (defvar markdown-cycle-global-status 1) 7217 (defvar markdown-cycle-subtree-status nil) 7218 7219 (defun markdown-next-preface () 7220 (let (finish) 7221 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") 7222 nil 'move)) 7223 (unless (markdown-code-block-at-point-p) 7224 (goto-char (match-beginning 0)) 7225 (setq finish t)))) 7226 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) 7227 (forward-char -1))) 7228 7229 (defun markdown-show-entry () 7230 (save-excursion 7231 (outline-back-to-heading t) 7232 (outline-flag-region (1- (point)) 7233 (progn 7234 (markdown-next-preface) 7235 (if (= 1 (- (point-max) (point))) 7236 (point-max) 7237 (point))) 7238 nil))) 7239 7240 ;; This function was originally derived from `org-cycle' from org.el. 7241 (defun markdown-cycle (&optional arg) 7242 "Visibility cycling for Markdown mode. 7243 This function is called with a `\\[universal-argument]' or if ARG is t, perform 7244 global visibility cycling. If the point is at an atx-style header, cycle 7245 visibility of the corresponding subtree. Otherwise, indent the current line 7246 or insert a tab, as appropriate, by calling `indent-for-tab-command'." 7247 (interactive "P") 7248 (cond 7249 7250 ;; Global cycling 7251 (arg 7252 (cond 7253 ;; Move from overview to contents 7254 ((and (eq last-command this-command) 7255 (eq markdown-cycle-global-status 2)) 7256 (outline-hide-sublevels 1) 7257 (message "CONTENTS") 7258 (setq markdown-cycle-global-status 3) 7259 (markdown-outline-fix-visibility)) 7260 ;; Move from contents to all 7261 ((and (eq last-command this-command) 7262 (eq markdown-cycle-global-status 3)) 7263 (outline-show-all) 7264 (message "SHOW ALL") 7265 (setq markdown-cycle-global-status 1)) 7266 ;; Defaults to overview 7267 (t 7268 (outline-hide-body) 7269 (message "OVERVIEW") 7270 (setq markdown-cycle-global-status 2) 7271 (markdown-outline-fix-visibility)))) 7272 7273 ;; At a heading: rotate between three different views 7274 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) 7275 (markdown-back-to-heading) 7276 (let ((goal-column 0) eoh eol eos) 7277 ;; Determine boundaries 7278 (save-excursion 7279 (markdown-back-to-heading) 7280 (save-excursion 7281 (beginning-of-line 2) 7282 (while (and (not (eobp)) ;; this is like `next-line' 7283 (get-char-property (1- (point)) 'invisible)) 7284 (beginning-of-line 2)) (setq eol (point))) 7285 (markdown-end-of-heading) (setq eoh (point)) 7286 (markdown-end-of-subtree t) 7287 (skip-chars-forward " \t\n") 7288 (beginning-of-line 1) ; in case this is an item 7289 (setq eos (1- (point)))) 7290 ;; Find out what to do next and set `this-command' 7291 (cond 7292 ;; Nothing is hidden behind this heading 7293 ((= eos eoh) 7294 (message "EMPTY ENTRY") 7295 (setq markdown-cycle-subtree-status nil)) 7296 ;; Entire subtree is hidden in one line: open it 7297 ((>= eol eos) 7298 (markdown-show-entry) 7299 (outline-show-children) 7300 (message "CHILDREN") 7301 (setq markdown-cycle-subtree-status 'children)) 7302 ;; We just showed the children, now show everything. 7303 ((and (eq last-command this-command) 7304 (eq markdown-cycle-subtree-status 'children)) 7305 (outline-show-subtree) 7306 (message "SUBTREE") 7307 (setq markdown-cycle-subtree-status 'subtree)) 7308 ;; Default action: hide the subtree. 7309 (t 7310 (outline-hide-subtree) 7311 (message "FOLDED") 7312 (setq markdown-cycle-subtree-status 'folded))))) 7313 7314 ;; In a table, move forward by one cell 7315 ((markdown-table-at-point-p) 7316 (call-interactively #'markdown-table-forward-cell)) 7317 7318 ;; Otherwise, indent as appropriate 7319 (t 7320 (indent-for-tab-command)))) 7321 7322 (defun markdown-shifttab () 7323 "Handle S-TAB keybinding based on context. 7324 When in a table, move backward one cell. 7325 Otherwise, cycle global heading visibility by calling 7326 `markdown-cycle' with argument t." 7327 (interactive) 7328 (cond ((markdown-table-at-point-p) 7329 (call-interactively #'markdown-table-backward-cell)) 7330 (t (markdown-cycle t)))) 7331 7332 (defun markdown-outline-level () 7333 "Return the depth to which a statement is nested in the outline." 7334 (cond 7335 ((and (match-beginning 0) 7336 (markdown-code-block-at-pos (match-beginning 0))) 7337 7) ;; Only 6 header levels are defined. 7338 ((match-end 2) 1) 7339 ((match-end 3) 2) 7340 ((match-end 4) 7341 (length (markdown-trim-whitespace (match-string-no-properties 4)))))) 7342 7343 (defun markdown-promote-subtree (&optional arg) 7344 "Promote the current subtree of ATX headings. 7345 Note that Markdown does not support heading levels higher than 7346 six and therefore level-six headings will not be promoted 7347 further. If ARG is non-nil promote the heading, otherwise 7348 demote." 7349 (interactive "*P") 7350 (save-excursion 7351 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) 7352 (re-search-backward markdown-regex-header-atx nil t)) 7353 (not (markdown-code-block-at-point-p))) 7354 (let ((level (length (match-string 1))) 7355 (promote-or-demote (if arg 1 -1)) 7356 (remove 't)) 7357 (markdown-cycle-atx promote-or-demote remove) 7358 (catch 'end-of-subtree 7359 (while (and (markdown-next-heading) 7360 (looking-at markdown-regex-header-atx)) 7361 ;; Exit if this not a higher level heading; promote otherwise. 7362 (if (and (looking-at markdown-regex-header-atx) 7363 (<= (length (match-string-no-properties 1)) level)) 7364 (throw 'end-of-subtree nil) 7365 (markdown-cycle-atx promote-or-demote remove)))))))) 7366 7367 (defun markdown-demote-subtree () 7368 "Demote the current subtree of ATX headings." 7369 (interactive) 7370 (markdown-promote-subtree t)) 7371 7372 (defun markdown-move-subtree-up () 7373 "Move the current subtree of ATX headings up." 7374 (interactive) 7375 (outline-move-subtree-up 1)) 7376 7377 (defun markdown-move-subtree-down () 7378 "Move the current subtree of ATX headings down." 7379 (interactive) 7380 (outline-move-subtree-down 1)) 7381 7382 (defun markdown-outline-next () 7383 "Move to next list item, when in a list, or next visible heading." 7384 (interactive) 7385 (let ((bounds (markdown-next-list-item-bounds))) 7386 (if bounds 7387 (goto-char (nth 0 bounds)) 7388 (markdown-next-visible-heading 1)))) 7389 7390 (defun markdown-outline-previous () 7391 "Move to previous list item, when in a list, or previous visible heading." 7392 (interactive) 7393 (let ((bounds (markdown-prev-list-item-bounds))) 7394 (if bounds 7395 (goto-char (nth 0 bounds)) 7396 (markdown-previous-visible-heading 1)))) 7397 7398 (defun markdown-outline-next-same-level () 7399 "Move to next list item or heading of same level." 7400 (interactive) 7401 (let ((bounds (markdown-cur-list-item-bounds))) 7402 (if bounds 7403 (markdown-next-list-item (nth 3 bounds)) 7404 (markdown-forward-same-level 1)))) 7405 7406 (defun markdown-outline-previous-same-level () 7407 "Move to previous list item or heading of same level." 7408 (interactive) 7409 (let ((bounds (markdown-cur-list-item-bounds))) 7410 (if bounds 7411 (markdown-prev-list-item (nth 3 bounds)) 7412 (markdown-backward-same-level 1)))) 7413 7414 (defun markdown-outline-up () 7415 "Move to previous list item, when in a list, or previous heading." 7416 (interactive) 7417 (unless (markdown-up-list) 7418 (markdown-up-heading 1))) 7419 7420 7421 ;;; Marking and Narrowing ===================================================== 7422 7423 (defun markdown-mark-paragraph () 7424 "Put mark at end of this block, point at beginning. 7425 The block marked is the one that contains point or follows point. 7426 7427 Interactively, if this command is repeated or (in Transient Mark 7428 mode) if the mark is active, it marks the next block after the 7429 ones already marked." 7430 (interactive) 7431 (if (or (and (eq last-command this-command) (mark t)) 7432 (and transient-mark-mode mark-active)) 7433 (set-mark 7434 (save-excursion 7435 (goto-char (mark)) 7436 (markdown-forward-paragraph) 7437 (point))) 7438 (let ((beginning-of-defun-function #'markdown-backward-paragraph) 7439 (end-of-defun-function #'markdown-forward-paragraph)) 7440 (mark-defun)))) 7441 7442 (defun markdown-mark-block () 7443 "Put mark at end of this block, point at beginning. 7444 The block marked is the one that contains point or follows point. 7445 7446 Interactively, if this command is repeated or (in Transient Mark 7447 mode) if the mark is active, it marks the next block after the 7448 ones already marked." 7449 (interactive) 7450 (if (or (and (eq last-command this-command) (mark t)) 7451 (and transient-mark-mode mark-active)) 7452 (set-mark 7453 (save-excursion 7454 (goto-char (mark)) 7455 (markdown-forward-block) 7456 (point))) 7457 (let ((beginning-of-defun-function #'markdown-backward-block) 7458 (end-of-defun-function #'markdown-forward-block)) 7459 (mark-defun)))) 7460 7461 (defun markdown-narrow-to-block () 7462 "Make text outside current block invisible. 7463 The current block is the one that contains point or follows point." 7464 (interactive) 7465 (let ((beginning-of-defun-function #'markdown-backward-block) 7466 (end-of-defun-function #'markdown-forward-block)) 7467 (narrow-to-defun))) 7468 7469 (defun markdown-mark-text-block () 7470 "Put mark at end of this plain text block, point at beginning. 7471 The block marked is the one that contains point or follows point. 7472 7473 Interactively, if this command is repeated or (in Transient Mark 7474 mode) if the mark is active, it marks the next block after the 7475 ones already marked." 7476 (interactive) 7477 (if (or (and (eq last-command this-command) (mark t)) 7478 (and transient-mark-mode mark-active)) 7479 (set-mark 7480 (save-excursion 7481 (goto-char (mark)) 7482 (markdown-end-of-text-block) 7483 (point))) 7484 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) 7485 (end-of-defun-function #'markdown-end-of-text-block)) 7486 (mark-defun)))) 7487 7488 (defun markdown-mark-page () 7489 "Put mark at end of this top level section, point at beginning. 7490 The top level section marked is the one that contains point or 7491 follows point. 7492 7493 Interactively, if this command is repeated or (in Transient Mark 7494 mode) if the mark is active, it marks the next page after the 7495 ones already marked." 7496 (interactive) 7497 (if (or (and (eq last-command this-command) (mark t)) 7498 (and transient-mark-mode mark-active)) 7499 (set-mark 7500 (save-excursion 7501 (goto-char (mark)) 7502 (markdown-forward-page) 7503 (point))) 7504 (let ((beginning-of-defun-function #'markdown-backward-page) 7505 (end-of-defun-function #'markdown-forward-page)) 7506 (mark-defun)))) 7507 7508 (defun markdown-narrow-to-page () 7509 "Make text outside current top level section invisible. 7510 The current section is the one that contains point or follows point." 7511 (interactive) 7512 (let ((beginning-of-defun-function #'markdown-backward-page) 7513 (end-of-defun-function #'markdown-forward-page)) 7514 (narrow-to-defun))) 7515 7516 (defun markdown-mark-subtree () 7517 "Mark the current subtree. 7518 This puts point at the start of the current subtree, and mark at the end." 7519 (interactive) 7520 (let ((beg)) 7521 (if (markdown-heading-at-point) 7522 (beginning-of-line) 7523 (markdown-previous-visible-heading 1)) 7524 (setq beg (point)) 7525 (markdown-end-of-subtree) 7526 (push-mark (point) nil t) 7527 (goto-char beg))) 7528 7529 (defun markdown-narrow-to-subtree () 7530 "Narrow buffer to the current subtree." 7531 (interactive) 7532 (save-excursion 7533 (save-match-data 7534 (narrow-to-region 7535 (progn (markdown-back-to-heading-over-code-block t) (point)) 7536 (progn (markdown-end-of-subtree) 7537 (if (and (markdown-heading-at-point) (not (eobp))) 7538 (backward-char 1)) 7539 (point)))))) 7540 7541 7542 ;;; Generic Structure Editing, Completion, and Cycling Commands =============== 7543 7544 (defun markdown-move-up () 7545 "Move thing at point up. 7546 When in a list item, call `markdown-move-list-item-up'. 7547 When in a table, call `markdown-table-move-row-up'. 7548 Otherwise, move the current heading subtree up with 7549 `markdown-move-subtree-up'." 7550 (interactive) 7551 (cond 7552 ((markdown-list-item-at-point-p) 7553 (call-interactively #'markdown-move-list-item-up)) 7554 ((markdown-table-at-point-p) 7555 (call-interactively #'markdown-table-move-row-up)) 7556 (t 7557 (call-interactively #'markdown-move-subtree-up)))) 7558 7559 (defun markdown-move-down () 7560 "Move thing at point down. 7561 When in a list item, call `markdown-move-list-item-down'. 7562 Otherwise, move the current heading subtree up with 7563 `markdown-move-subtree-down'." 7564 (interactive) 7565 (cond 7566 ((markdown-list-item-at-point-p) 7567 (call-interactively #'markdown-move-list-item-down)) 7568 ((markdown-table-at-point-p) 7569 (call-interactively #'markdown-table-move-row-down)) 7570 (t 7571 (call-interactively #'markdown-move-subtree-down)))) 7572 7573 (defun markdown-promote () 7574 "Promote or move element at point to the left. 7575 Depending on the context, this function will promote a heading or 7576 list item at the point, move a table column to the left, or cycle 7577 markup." 7578 (interactive) 7579 (let (bounds) 7580 (cond 7581 ;; Promote atx heading subtree 7582 ((thing-at-point-looking-at markdown-regex-header-atx) 7583 (markdown-promote-subtree)) 7584 ;; Promote setext heading 7585 ((thing-at-point-looking-at markdown-regex-header-setext) 7586 (markdown-cycle-setext -1)) 7587 ;; Promote horizontal rule 7588 ((thing-at-point-looking-at markdown-regex-hr) 7589 (markdown-cycle-hr -1)) 7590 ;; Promote list item 7591 ((setq bounds (markdown-cur-list-item-bounds)) 7592 (markdown-promote-list-item bounds)) 7593 ;; Move table column to the left 7594 ((markdown-table-at-point-p) 7595 (call-interactively #'markdown-table-move-column-left)) 7596 ;; Promote bold 7597 ((thing-at-point-looking-at markdown-regex-bold) 7598 (markdown-cycle-bold)) 7599 ;; Promote italic 7600 ((thing-at-point-looking-at markdown-regex-italic) 7601 (markdown-cycle-italic)) 7602 (t 7603 (user-error "Nothing to promote at point"))))) 7604 7605 (defun markdown-demote () 7606 "Demote or move element at point to the right. 7607 Depending on the context, this function will demote a heading or 7608 list item at the point, move a table column to the right, or cycle 7609 or remove markup." 7610 (interactive) 7611 (let (bounds) 7612 (cond 7613 ;; Demote atx heading subtree 7614 ((thing-at-point-looking-at markdown-regex-header-atx) 7615 (markdown-demote-subtree)) 7616 ;; Demote setext heading 7617 ((thing-at-point-looking-at markdown-regex-header-setext) 7618 (markdown-cycle-setext 1)) 7619 ;; Demote horizontal rule 7620 ((thing-at-point-looking-at markdown-regex-hr) 7621 (markdown-cycle-hr 1)) 7622 ;; Demote list item 7623 ((setq bounds (markdown-cur-list-item-bounds)) 7624 (markdown-demote-list-item bounds)) 7625 ;; Move table column to the right 7626 ((markdown-table-at-point-p) 7627 (call-interactively #'markdown-table-move-column-right)) 7628 ;; Demote bold 7629 ((thing-at-point-looking-at markdown-regex-bold) 7630 (markdown-cycle-bold)) 7631 ;; Demote italic 7632 ((thing-at-point-looking-at markdown-regex-italic) 7633 (markdown-cycle-italic)) 7634 (t 7635 (user-error "Nothing to demote at point"))))) 7636 7637 7638 ;;; Commands ================================================================== 7639 7640 (defun markdown (&optional output-buffer-name) 7641 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. 7642 The output buffer name defaults to `markdown-output-buffer-name'. 7643 Return the name of the output buffer used." 7644 (interactive) 7645 (save-window-excursion 7646 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) 7647 ((listp markdown-command) markdown-command))) 7648 (command (car-safe commands)) 7649 (command-args (cdr-safe commands)) 7650 begin-region end-region) 7651 (if (use-region-p) 7652 (setq begin-region (region-beginning) 7653 end-region (region-end)) 7654 (setq begin-region (point-min) 7655 end-region (point-max))) 7656 7657 (unless output-buffer-name 7658 (setq output-buffer-name markdown-output-buffer-name)) 7659 (when (and (stringp command) (not (executable-find command))) 7660 (user-error "Markdown command %s is not found" command)) 7661 (let ((exit-code 7662 (cond 7663 ;; Handle case when `markdown-command' does not read from stdin 7664 ((and (stringp command) markdown-command-needs-filename) 7665 (if (not buffer-file-name) 7666 (user-error "Must be visiting a file") 7667 ;; Don’t use ‘shell-command’ because it’s not guaranteed to 7668 ;; return the exit code of the process. 7669 (let ((command (if (listp markdown-command) 7670 (string-join markdown-command " ") 7671 markdown-command))) 7672 (shell-command-on-region 7673 ;; Pass an empty region so that stdin is empty. 7674 (point) (point) 7675 (concat command " " 7676 (shell-quote-argument buffer-file-name)) 7677 output-buffer-name)))) 7678 ;; Pass region to `markdown-command' via stdin 7679 (t 7680 (let ((buf (get-buffer-create output-buffer-name))) 7681 (with-current-buffer buf 7682 (setq buffer-read-only nil) 7683 (erase-buffer)) 7684 (if (stringp command) 7685 (if (not (null command-args)) 7686 (apply #'call-process-region begin-region end-region command nil buf nil command-args) 7687 (call-process-region begin-region end-region command nil buf)) 7688 (if markdown-command-needs-filename 7689 (if (not buffer-file-name) 7690 (user-error "Must be visiting a file") 7691 (funcall markdown-command begin-region end-region buf buffer-file-name)) 7692 (funcall markdown-command begin-region end-region buf)) 7693 ;; If the ‘markdown-command’ function didn’t signal an 7694 ;; error, assume it succeeded by binding ‘exit-code’ to 0. 7695 0)))))) 7696 ;; The exit code can be a signal description string, so don’t use ‘=’ 7697 ;; or ‘zerop’. 7698 (unless (eq exit-code 0) 7699 (user-error "%s failed with exit code %s" 7700 markdown-command exit-code)))) 7701 output-buffer-name)) 7702 7703 (defun markdown-standalone (&optional output-buffer-name) 7704 "Special function to provide standalone HTML output. 7705 Insert the output in the buffer named OUTPUT-BUFFER-NAME." 7706 (interactive) 7707 (setq output-buffer-name (markdown output-buffer-name)) 7708 (let ((css-path markdown-css-paths)) 7709 (with-current-buffer output-buffer-name 7710 (set-buffer output-buffer-name) 7711 (setq-local markdown-css-paths css-path) 7712 (unless (markdown-output-standalone-p) 7713 (markdown-add-xhtml-header-and-footer output-buffer-name)) 7714 (goto-char (point-min)) 7715 (html-mode))) 7716 output-buffer-name) 7717 7718 (defun markdown-other-window (&optional output-buffer-name) 7719 "Run `markdown-command' on current buffer and display in other window. 7720 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7721 that name." 7722 (interactive) 7723 (markdown-display-buffer-other-window 7724 (markdown-standalone output-buffer-name))) 7725 7726 (defun markdown-output-standalone-p () 7727 "Determine whether `markdown-command' output is standalone XHTML. 7728 Standalone XHTML output is identified by an occurrence of 7729 `markdown-xhtml-standalone-regexp' in the first five lines of output." 7730 (save-excursion 7731 (goto-char (point-min)) 7732 (save-match-data 7733 (re-search-forward 7734 markdown-xhtml-standalone-regexp 7735 (save-excursion (goto-char (point-min)) (forward-line 4) (point)) 7736 t)))) 7737 7738 (defun markdown-stylesheet-link-string (stylesheet-path) 7739 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" 7740 (expand-file-name stylesheet-path) 7741 "\" />")) 7742 7743 (defun markdown-escape-title (title) 7744 "Escape a minimum set of characters in TITLE so they don't clash with html." 7745 (replace-regexp-in-string ">" ">" 7746 (replace-regexp-in-string "<" "<" 7747 (replace-regexp-in-string "&" "&" title)))) 7748 7749 (defun markdown-add-xhtml-header-and-footer (title) 7750 "Wrap XHTML header and footer with given TITLE around current buffer." 7751 (goto-char (point-min)) 7752 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" 7753 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" 7754 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" 7755 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" 7756 "<head>\n<title>") 7757 (insert (markdown-escape-title title)) 7758 (insert "</title>\n") 7759 (unless (= (length markdown-content-type) 0) 7760 (insert 7761 (format 7762 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" 7763 markdown-content-type 7764 (or (and markdown-coding-system 7765 (coding-system-get markdown-coding-system 7766 'mime-charset)) 7767 (coding-system-get buffer-file-coding-system 7768 'mime-charset) 7769 "utf-8")))) 7770 (if (> (length markdown-css-paths) 0) 7771 (insert (mapconcat #'markdown-stylesheet-link-string 7772 markdown-css-paths "\n"))) 7773 (when (> (length markdown-xhtml-header-content) 0) 7774 (insert markdown-xhtml-header-content)) 7775 (insert "\n</head>\n\n" 7776 "<body>\n\n") 7777 (when (> (length markdown-xhtml-body-preamble) 0) 7778 (insert markdown-xhtml-body-preamble "\n")) 7779 (goto-char (point-max)) 7780 (when (> (length markdown-xhtml-body-epilogue) 0) 7781 (insert "\n" markdown-xhtml-body-epilogue)) 7782 (insert "\n" 7783 "</body>\n" 7784 "</html>\n")) 7785 7786 (defun markdown-preview (&optional output-buffer-name) 7787 "Run `markdown-command' on the current buffer and view output in browser. 7788 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7789 that name." 7790 (interactive) 7791 (browse-url-of-buffer 7792 (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) 7793 7794 (defun markdown-export-file-name (&optional extension) 7795 "Attempt to generate a filename for Markdown output. 7796 The file extension will be EXTENSION if given, or .html by default. 7797 If the current buffer is visiting a file, we construct a new 7798 output filename based on that filename. Otherwise, return nil." 7799 (when (buffer-file-name) 7800 (unless extension 7801 (setq extension ".html")) 7802 (let ((candidate 7803 (concat 7804 (cond 7805 ((buffer-file-name) 7806 (file-name-sans-extension (buffer-file-name))) 7807 (t (buffer-name))) 7808 extension))) 7809 (cond 7810 ((equal candidate (buffer-file-name)) 7811 (concat candidate extension)) 7812 (t 7813 candidate))))) 7814 7815 (defun markdown-export (&optional output-file) 7816 "Run Markdown on the current buffer, save to file, and return the filename. 7817 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename 7818 generated by `markdown-export-file-name', which will be constructed using the 7819 current filename, but with the extension removed and replaced with .html." 7820 (interactive) 7821 (unless output-file 7822 (setq output-file (markdown-export-file-name ".html"))) 7823 (when output-file 7824 (let* ((init-buf (current-buffer)) 7825 (init-point (point)) 7826 (init-buf-string (buffer-string)) 7827 (output-buffer (find-file-noselect output-file)) 7828 (output-buffer-name (buffer-name output-buffer))) 7829 (run-hooks 'markdown-before-export-hook) 7830 (markdown-standalone output-buffer-name) 7831 (with-current-buffer output-buffer 7832 (run-hooks 'markdown-after-export-hook) 7833 (save-buffer) 7834 (when markdown-export-kill-buffer (kill-buffer))) 7835 ;; if modified, restore initial buffer 7836 (when (buffer-modified-p init-buf) 7837 (erase-buffer) 7838 (insert init-buf-string) 7839 (save-buffer) 7840 (goto-char init-point)) 7841 output-file))) 7842 7843 (defun markdown-export-and-preview () 7844 "Export to XHTML using `markdown-export' and browse the resulting file." 7845 (interactive) 7846 (browse-url-of-file (markdown-export))) 7847 7848 (defvar-local markdown-live-preview-buffer nil 7849 "Buffer used to preview markdown output in `markdown-live-preview-export'.") 7850 7851 (defvar-local markdown-live-preview-source-buffer nil 7852 "Source buffer from which current buffer was generated. 7853 This is the inverse of `markdown-live-preview-buffer'.") 7854 7855 (defvar markdown-live-preview-currently-exporting nil) 7856 7857 (defun markdown-live-preview-get-filename () 7858 "Standardize the filename exported by `markdown-live-preview-export'." 7859 (markdown-export-file-name ".html")) 7860 7861 (defun markdown-live-preview-window-eww (file) 7862 "Preview FILE with eww. 7863 To be used with `markdown-live-preview-window-function'." 7864 (when (and (bound-and-true-p eww-auto-rename-buffer) 7865 markdown-live-preview-buffer) 7866 (kill-buffer markdown-live-preview-buffer)) 7867 (eww-open-file file) 7868 ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" 7869 ;; Try to find the buffer whose name ends with "eww*" 7870 (if (bound-and-true-p eww-auto-rename-buffer) 7871 (cl-loop for buf in (buffer-list) 7872 when (string-match-p "eww\\*\\'" (buffer-name buf)) 7873 return buf) 7874 (get-buffer "*eww*"))) 7875 7876 (defun markdown-visual-lines-between-points (beg end) 7877 (save-excursion 7878 (goto-char beg) 7879 (cl-loop with count = 0 7880 while (progn (end-of-visual-line) 7881 (and (< (point) end) (line-move-visual 1 t))) 7882 do (cl-incf count) 7883 finally return count))) 7884 7885 (defun markdown-live-preview-window-serialize (buf) 7886 "Get window point and scroll data for all windows displaying BUF." 7887 (when (buffer-live-p buf) 7888 (with-current-buffer buf 7889 (mapcar 7890 (lambda (win) 7891 (with-selected-window win 7892 (let* ((start (window-start)) 7893 (pt (window-point)) 7894 (pt-or-sym (cond ((= pt (point-min)) 'min) 7895 ((= pt (point-max)) 'max) 7896 (t pt))) 7897 (diff (markdown-visual-lines-between-points 7898 start pt))) 7899 (list win pt-or-sym diff)))) 7900 (get-buffer-window-list buf))))) 7901 7902 (defun markdown-get-point-back-lines (pt num-lines) 7903 (save-excursion 7904 (goto-char pt) 7905 (line-move-visual (- num-lines) t) 7906 ;; in testing, can occasionally overshoot the number of lines to traverse 7907 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) 7908 (when (> actual-num-lines num-lines) 7909 (line-move-visual (- actual-num-lines num-lines) t))) 7910 (point))) 7911 7912 (defun markdown-live-preview-window-deserialize (window-posns) 7913 "Apply window point and scroll data from WINDOW-POSNS. 7914 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." 7915 (cl-destructuring-bind (win pt-or-sym diff) window-posns 7916 (when (window-live-p win) 7917 (with-current-buffer markdown-live-preview-buffer 7918 (set-window-buffer win (current-buffer)) 7919 (cl-destructuring-bind (actual-pt actual-diff) 7920 (cl-case pt-or-sym 7921 (min (list (point-min) 0)) 7922 (max (list (point-max) diff)) 7923 (t (list pt-or-sym diff))) 7924 (set-window-start 7925 win (markdown-get-point-back-lines actual-pt actual-diff)) 7926 (set-window-point win actual-pt)))))) 7927 7928 (defun markdown-live-preview-export () 7929 "Export to XHTML using `markdown-export'. 7930 Browse the resulting file within Emacs using 7931 `markdown-live-preview-window-function' Return the buffer 7932 displaying the rendered output." 7933 (interactive) 7934 (let ((filename (markdown-live-preview-get-filename))) 7935 (when filename 7936 (let* ((markdown-live-preview-currently-exporting t) 7937 (cur-buf (current-buffer)) 7938 (export-file (markdown-export filename)) 7939 ;; get positions in all windows currently displaying output buffer 7940 (window-data 7941 (markdown-live-preview-window-serialize 7942 markdown-live-preview-buffer))) 7943 (save-window-excursion 7944 (let ((output-buffer 7945 (funcall markdown-live-preview-window-function export-file))) 7946 (with-current-buffer output-buffer 7947 (setq markdown-live-preview-source-buffer cur-buf) 7948 (add-hook 'kill-buffer-hook 7949 #'markdown-live-preview-remove-on-kill t t)) 7950 (with-current-buffer cur-buf 7951 (setq markdown-live-preview-buffer output-buffer)))) 7952 (with-current-buffer cur-buf 7953 ;; reset all windows displaying output buffer to where they were, 7954 ;; now with the new output 7955 (mapc #'markdown-live-preview-window-deserialize window-data) 7956 ;; delete html editing buffer 7957 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) 7958 (when (and export-file (file-exists-p export-file) 7959 (eq markdown-live-preview-delete-export 7960 'delete-on-export)) 7961 (delete-file export-file)) 7962 markdown-live-preview-buffer))))) 7963 7964 (defun markdown-live-preview-remove () 7965 (when (buffer-live-p markdown-live-preview-buffer) 7966 (kill-buffer markdown-live-preview-buffer)) 7967 (setq markdown-live-preview-buffer nil) 7968 ;; if set to 'delete-on-export, the output has already been deleted 7969 (when (eq markdown-live-preview-delete-export 'delete-on-destroy) 7970 (let ((outfile-name (markdown-live-preview-get-filename))) 7971 (when (and outfile-name (file-exists-p outfile-name)) 7972 (delete-file outfile-name))))) 7973 7974 (defun markdown-get-other-window () 7975 "Find another window to display preview or output content." 7976 (cond 7977 ((memq markdown-split-window-direction '(vertical below)) 7978 (or (window-in-direction 'below) (split-window-vertically))) 7979 ((memq markdown-split-window-direction '(horizontal right)) 7980 (or (window-in-direction 'right) (split-window-horizontally))) 7981 (t (split-window-sensibly (get-buffer-window))))) 7982 7983 (defun markdown-display-buffer-other-window (buf) 7984 "Display preview or output buffer BUF in another window." 7985 (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) 7986 (display-buffer buf) 7987 (let ((cur-buf (current-buffer)) 7988 (window (markdown-get-other-window))) 7989 (set-window-buffer window buf) 7990 (set-buffer cur-buf)))) 7991 7992 (defun markdown-live-preview-if-markdown () 7993 (when (and (derived-mode-p 'markdown-mode) 7994 markdown-live-preview-mode) 7995 (unless markdown-live-preview-currently-exporting 7996 (if (buffer-live-p markdown-live-preview-buffer) 7997 (markdown-live-preview-export) 7998 (markdown-display-buffer-other-window 7999 (markdown-live-preview-export)))))) 8000 8001 (defun markdown-live-preview-remove-on-kill () 8002 (cond ((and (derived-mode-p 'markdown-mode) 8003 markdown-live-preview-mode) 8004 (markdown-live-preview-remove)) 8005 (markdown-live-preview-source-buffer 8006 (with-current-buffer markdown-live-preview-source-buffer 8007 (setq markdown-live-preview-buffer nil)) 8008 (setq markdown-live-preview-source-buffer nil)))) 8009 8010 (defun markdown-live-preview-switch-to-output () 8011 "Turn on `markdown-live-preview-mode' and switch to output buffer. 8012 The output buffer is opened in another window." 8013 (interactive) 8014 (if markdown-live-preview-mode 8015 (markdown-display-buffer-other-window (markdown-live-preview-export))) 8016 (markdown-live-preview-mode)) 8017 8018 (defun markdown-live-preview-re-export () 8019 "Re-export the current live previewed content. 8020 If the current buffer is a buffer displaying the exported version of a 8021 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and 8022 update this buffer's contents." 8023 (interactive) 8024 (when markdown-live-preview-source-buffer 8025 (with-current-buffer markdown-live-preview-source-buffer 8026 (markdown-live-preview-export)))) 8027 8028 (defun markdown-open () 8029 "Open file for the current buffer with `markdown-open-command'." 8030 (interactive) 8031 (unless markdown-open-command 8032 (user-error "Variable `markdown-open-command' must be set")) 8033 (if (stringp markdown-open-command) 8034 (if (not buffer-file-name) 8035 (user-error "Must be visiting a file") 8036 (save-buffer) 8037 (let ((exit-code (call-process markdown-open-command nil nil nil 8038 buffer-file-name))) 8039 ;; The exit code can be a signal description string, so don’t use ‘=’ 8040 ;; or ‘zerop’. 8041 (unless (eq exit-code 0) 8042 (user-error "%s failed with exit code %s" 8043 markdown-open-command exit-code)))) 8044 (funcall markdown-open-command)) 8045 nil) 8046 8047 (defun markdown-kill-ring-save () 8048 "Run Markdown on file and store output in the kill ring." 8049 (interactive) 8050 (save-window-excursion 8051 (markdown) 8052 (with-current-buffer markdown-output-buffer-name 8053 (kill-ring-save (point-min) (point-max))))) 8054 8055 8056 ;;; Links ===================================================================== 8057 8058 (defun markdown-backward-to-link-start () 8059 "Backward link start position if current position is in link title." 8060 ;; Issue #305 8061 (when (eq (get-text-property (point) 'face) 'markdown-link-face) 8062 (skip-chars-backward "^[") 8063 (forward-char -1))) 8064 8065 (defun markdown-link-p () 8066 "Return non-nil when `point' is at a non-wiki link. 8067 See `markdown-wiki-link-p' for more information." 8068 (save-excursion 8069 (let ((case-fold-search nil)) 8070 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) 8071 (markdown-backward-to-link-start) 8072 (or (thing-at-point-looking-at markdown-regex-link-inline) 8073 (thing-at-point-looking-at markdown-regex-link-reference) 8074 (thing-at-point-looking-at markdown-regex-uri) 8075 (thing-at-point-looking-at markdown-regex-angle-uri)))))) 8076 8077 (defun markdown-link-at-pos (pos) 8078 "Return properties of link or image at position POS. 8079 Value is a list of elements describing the link: 8080 0. beginning position 8081 1. end position 8082 2. link text 8083 3. URL 8084 4. reference label 8085 5. title text 8086 6. bang (nil or \"!\")" 8087 (save-excursion 8088 (goto-char pos) 8089 (markdown-backward-to-link-start) 8090 (let (begin end text url reference title bang) 8091 (cond 8092 ;; Inline image or link at point. 8093 ((thing-at-point-looking-at markdown-regex-link-inline) 8094 (setq bang (match-string-no-properties 1) 8095 begin (match-beginning 0) 8096 text (match-string-no-properties 3) 8097 url (match-string-no-properties 6)) 8098 ;; consider nested parentheses 8099 ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link 8100 (let* ((close-pos (scan-sexps (match-beginning 5) 1)) 8101 (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) 8102 (setq end close-pos) 8103 ;; A link can contain spaces if it is wrapped with angle brackets 8104 (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) 8105 (setq url (match-string-no-properties 1 destination-part))) 8106 ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) 8107 (setq url (match-string-no-properties 1 destination-part) 8108 title (substring (match-string-no-properties 2 destination-part) 1 -1))) 8109 (t (setq url destination-part))) 8110 (setq url (url-unhex-string url)))) 8111 ;; Reference link at point. 8112 ((thing-at-point-looking-at markdown-regex-link-reference) 8113 (setq bang (match-string-no-properties 1) 8114 begin (match-beginning 0) 8115 end (match-end 0) 8116 text (match-string-no-properties 3)) 8117 (when (char-equal (char-after (match-beginning 5)) ?\[) 8118 (setq reference (match-string-no-properties 6)))) 8119 ;; Angle bracket URI at point. 8120 ((thing-at-point-looking-at markdown-regex-angle-uri) 8121 (setq begin (match-beginning 0) 8122 end (match-end 0) 8123 url (match-string-no-properties 2))) 8124 ;; Plain URI at point. 8125 ((thing-at-point-looking-at markdown-regex-uri) 8126 (setq begin (match-beginning 0) 8127 end (match-end 0) 8128 url (match-string-no-properties 1)))) 8129 (list begin end text url reference title bang)))) 8130 8131 (defun markdown-link-url () 8132 "Return the URL part of the regular (non-wiki) link at point. 8133 Works with both inline and reference style links, and with images. 8134 If point is not at a link or the link reference is not defined 8135 returns nil." 8136 (let* ((values (markdown-link-at-pos (point))) 8137 (text (nth 2 values)) 8138 (url (nth 3 values)) 8139 (ref (nth 4 values))) 8140 (or url (and ref (car (markdown-reference-definition 8141 (downcase (if (string= ref "") text ref)))))))) 8142 8143 (defun markdown--browse-url (url) 8144 (let* ((struct (url-generic-parse-url url)) 8145 (full (url-fullness struct)) 8146 (file url)) 8147 ;; Parse URL, determine fullness, strip query string 8148 (setq file (car (url-path-and-query struct))) 8149 ;; Open full URLs in browser, files in Emacs 8150 (if full 8151 (browse-url url) 8152 (when (and file (> (length file) 0)) 8153 (let ((link-file (funcall markdown-translate-filename-function file))) 8154 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) 8155 (if (functionp markdown-open-image-command) 8156 (funcall markdown-open-image-command link-file) 8157 (process-file markdown-open-image-command nil nil nil link-file)) 8158 (find-file link-file))))))) 8159 8160 (defun markdown-follow-link-at-point (&optional event) 8161 "Open the non-wiki link at point or EVENT. 8162 If the link is a complete URL, open in browser with `browse-url'. 8163 Otherwise, open with `find-file' after stripping anchor and/or query string. 8164 Translate filenames using `markdown-filename-translate-function'." 8165 (interactive (list last-command-event)) 8166 (if event (posn-set-point (event-start event))) 8167 (if (markdown-link-p) 8168 (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) 8169 (markdown--browse-url (markdown-link-url))) 8170 (user-error "Point is not at a Markdown link or URL"))) 8171 8172 (defun markdown-fontify-inline-links (last) 8173 "Add text properties to next inline link from point to LAST." 8174 (when (markdown-match-generic-links last nil) 8175 (let* ((link-start (match-beginning 3)) 8176 (link-end (match-end 3)) 8177 (url-start (match-beginning 6)) 8178 (url-end (match-end 6)) 8179 (url (match-string-no-properties 6)) 8180 (title-start (match-beginning 7)) 8181 (title-end (match-end 7)) 8182 (title (match-string-no-properties 7)) 8183 ;; Markup part 8184 (mp (list 'invisible 'markdown-markup 8185 'rear-nonsticky t 8186 'font-lock-multiline t)) 8187 ;; Link part (without face) 8188 (lp (list 'keymap markdown-mode-mouse-map 8189 'mouse-face 'markdown-highlight-face 8190 'font-lock-multiline t 8191 'help-echo (if title (concat title "\n" url) url))) 8192 ;; URL part 8193 (up (list 'keymap markdown-mode-mouse-map 8194 'invisible 'markdown-markup 8195 'mouse-face 'markdown-highlight-face 8196 'font-lock-multiline t)) 8197 ;; URL composition character 8198 (url-char (markdown--first-displayable markdown-url-compose-char)) 8199 ;; Title part 8200 (tp (list 'invisible 'markdown-markup 8201 'font-lock-multiline t))) 8202 (dolist (g '(1 2 4 5 8)) 8203 (when (match-end g) 8204 (add-text-properties (match-beginning g) (match-end g) mp) 8205 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8206 ;; Preserve existing faces applied to link part (e.g., inline code) 8207 (when link-start 8208 (add-text-properties link-start link-end lp) 8209 (add-face-text-property link-start link-end 'markdown-link-face)) 8210 (when url-start 8211 (add-text-properties url-start url-end up) 8212 (add-face-text-property url-start url-end 'markdown-url-face)) 8213 (when title-start 8214 (add-text-properties url-end title-end tp) 8215 (add-face-text-property url-end title-end 'markdown-link-title-face)) 8216 (when (and markdown-hide-urls url-start) 8217 (compose-region url-start (or title-end url-end) url-char)) 8218 t))) 8219 8220 (defun markdown-fontify-reference-links (last) 8221 "Add text properties to next reference link from point to LAST." 8222 (when (markdown-match-generic-links last t) 8223 (let* ((link-start (match-beginning 3)) 8224 (link-end (match-end 3)) 8225 (ref-start (match-beginning 6)) 8226 (ref-end (match-end 6)) 8227 ;; Markup part 8228 (mp (list 'invisible 'markdown-markup 8229 'rear-nonsticky t 8230 'font-lock-multiline t)) 8231 ;; Link part 8232 (lp (list 'keymap markdown-mode-mouse-map 8233 'mouse-face 'markdown-highlight-face 8234 'font-lock-multiline t 8235 'help-echo (lambda (_ __ pos) 8236 (save-match-data 8237 (save-excursion 8238 (goto-char pos) 8239 (or (markdown-link-url) 8240 "Undefined reference")))))) 8241 ;; URL composition character 8242 (url-char (markdown--first-displayable markdown-url-compose-char)) 8243 ;; Reference part 8244 (rp (list 'invisible 'markdown-markup 8245 'font-lock-multiline t))) 8246 (dolist (g '(1 2 4 5 8)) 8247 (when (match-end g) 8248 (add-text-properties (match-beginning g) (match-end g) mp) 8249 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8250 (when link-start 8251 (add-text-properties link-start link-end lp) 8252 (add-face-text-property link-start link-end 'markdown-link-face)) 8253 (when ref-start 8254 (add-text-properties ref-start ref-end rp) 8255 (add-face-text-property ref-start ref-end 'markdown-reference-face) 8256 (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) 8257 (compose-region ref-start ref-end url-char))) 8258 t))) 8259 8260 (defun markdown-fontify-angle-uris (last) 8261 "Add text properties to angle URIs from point to LAST." 8262 (when (markdown-match-angle-uris last) 8263 (let* ((url-start (match-beginning 2)) 8264 (url-end (match-end 2)) 8265 ;; Markup part 8266 (mp (list 'face 'markdown-markup-face 8267 'invisible 'markdown-markup 8268 'rear-nonsticky t 8269 'font-lock-multiline t)) 8270 ;; URI part 8271 (up (list 'keymap markdown-mode-mouse-map 8272 'face 'markdown-plain-url-face 8273 'mouse-face 'markdown-highlight-face 8274 'font-lock-multiline t))) 8275 (dolist (g '(1 3)) 8276 (add-text-properties (match-beginning g) (match-end g) mp)) 8277 (add-text-properties url-start url-end up) 8278 t))) 8279 8280 (defun markdown-fontify-plain-uris (last) 8281 "Add text properties to plain URLs from point to LAST." 8282 (when (markdown-match-plain-uris last) 8283 (let* ((start (match-beginning 0)) 8284 (end (match-end 0)) 8285 (props (list 'keymap markdown-mode-mouse-map 8286 'face 'markdown-plain-url-face 8287 'mouse-face 'markdown-highlight-face 8288 'rear-nonsticky t 8289 'font-lock-multiline t))) 8290 (add-text-properties start end props) 8291 t))) 8292 8293 (defun markdown-toggle-url-hiding (&optional arg) 8294 "Toggle the display or hiding of URLs. 8295 With a prefix argument ARG, enable URL hiding if ARG is positive, 8296 and disable it otherwise." 8297 (interactive (list (or current-prefix-arg 'toggle))) 8298 (setq markdown-hide-urls 8299 (if (eq arg 'toggle) 8300 (not markdown-hide-urls) 8301 (> (prefix-numeric-value arg) 0))) 8302 (when (called-interactively-p 'interactive) 8303 (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) 8304 (markdown-reload-extensions)) 8305 8306 8307 ;;; Wiki Links ================================================================ 8308 8309 (defun markdown-wiki-link-p () 8310 "Return non-nil if wiki links are enabled and `point' is at a true wiki link. 8311 A true wiki link name matches `markdown-regex-wiki-link' but does 8312 not match the current file name after conversion. This modifies 8313 the data returned by `match-data'. Note that the potential wiki 8314 link name must be available via `match-string'." 8315 (when markdown-enable-wiki-links 8316 (let ((case-fold-search nil)) 8317 (and (thing-at-point-looking-at markdown-regex-wiki-link) 8318 (not (markdown-code-block-at-point-p)) 8319 (or (not buffer-file-name) 8320 (not (string-equal (buffer-file-name) 8321 (markdown-convert-wiki-link-to-filename 8322 (markdown-wiki-link-link))))))))) 8323 8324 (defun markdown-wiki-link-link () 8325 "Return the link part of the wiki link using current match data. 8326 The location of the link component depends on the value of 8327 `markdown-wiki-link-alias-first'." 8328 (if markdown-wiki-link-alias-first 8329 (or (match-string-no-properties 5) (match-string-no-properties 3)) 8330 (match-string-no-properties 3))) 8331 8332 (defun markdown-wiki-link-alias () 8333 "Return the alias or text part of the wiki link using current match data. 8334 The location of the alias component depends on the value of 8335 `markdown-wiki-link-alias-first'." 8336 (if markdown-wiki-link-alias-first 8337 (match-string-no-properties 3) 8338 (or (match-string-no-properties 5) (match-string-no-properties 3)))) 8339 8340 (defun markdown--wiki-link-search-types () 8341 (let ((ret (and markdown-wiki-link-search-type 8342 (cl-copy-list markdown-wiki-link-search-type)))) 8343 (when (and markdown-wiki-link-search-subdirectories 8344 (not (memq 'sub-directories markdown-wiki-link-search-type))) 8345 (push 'sub-directories ret)) 8346 (when (and markdown-wiki-link-search-parent-directories 8347 (not (memq 'parent-directories markdown-wiki-link-search-type))) 8348 (push 'parent-directories ret)) 8349 ret)) 8350 8351 (defun markdown--project-root () 8352 (or (cl-loop for dir in '(".git" ".hg" ".svn") 8353 when (locate-dominating-file default-directory dir) 8354 return it) 8355 (progn 8356 (require 'project) 8357 (let ((project (project-current t))) 8358 (with-no-warnings 8359 (if (fboundp 'project-root) 8360 (project-root project) 8361 (car (project-roots project)))))))) 8362 8363 (defun markdown-convert-wiki-link-to-filename (name) 8364 "Generate a filename from the wiki link NAME. 8365 Spaces in NAME are replaced with `markdown-link-space-sub-char'. 8366 When in `gfm-mode', follow GitHub's conventions where [[Test Test]] 8367 and [[test test]] both map to Test-test.ext. Look in the current 8368 directory first, then in subdirectories if 8369 `markdown-wiki-link-search-subdirectories' is non-nil, and then 8370 in parent directories if 8371 `markdown-wiki-link-search-parent-directories' is non-nil." 8372 (save-match-data 8373 ;; This function must not overwrite match data(PR #590) 8374 (let* ((basename (replace-regexp-in-string 8375 "[[:space:]\n]" markdown-link-space-sub-char name)) 8376 (basename (if (derived-mode-p 'gfm-mode) 8377 (concat (upcase (substring basename 0 1)) 8378 (downcase (substring basename 1 nil))) 8379 basename)) 8380 (search-types (markdown--wiki-link-search-types)) 8381 directory extension default candidates dir) 8382 (when buffer-file-name 8383 (setq directory (file-name-directory buffer-file-name) 8384 extension (file-name-extension buffer-file-name))) 8385 (setq default (concat basename 8386 (when extension (concat "." extension)))) 8387 (cond 8388 ;; Look in current directory first. 8389 ((or (null buffer-file-name) 8390 (file-exists-p default)) 8391 default) 8392 ;; Possibly search in subdirectories, next. 8393 ((and (memq 'sub-directories search-types) 8394 (setq candidates 8395 (directory-files-recursively 8396 directory (concat "^" default "$")))) 8397 (car candidates)) 8398 ;; Possibly search in parent directories as a last resort. 8399 ((and (memq 'parent-directories search-types) 8400 (setq dir (locate-dominating-file directory default))) 8401 (concat dir default)) 8402 ((and (memq 'project search-types) 8403 (setq candidates 8404 (directory-files-recursively 8405 (markdown--project-root) (concat "^" default "$")))) 8406 (car candidates)) 8407 ;; If nothing is found, return default in current directory. 8408 (t default))))) 8409 8410 (defun markdown-follow-wiki-link (name &optional other) 8411 "Follow the wiki link NAME. 8412 Convert the name to a file name and call `find-file'. Ensure that 8413 the new buffer remains in `markdown-mode'. Open the link in another 8414 window when OTHER is non-nil." 8415 (let ((filename (markdown-convert-wiki-link-to-filename name)) 8416 (wp (when buffer-file-name 8417 (file-name-directory buffer-file-name)))) 8418 (if (not wp) 8419 (user-error "Must be visiting a file") 8420 (when other (other-window 1)) 8421 (let ((default-directory wp)) 8422 (find-file filename))) 8423 (unless (derived-mode-p 'markdown-mode) 8424 (markdown-mode)))) 8425 8426 (defun markdown-follow-wiki-link-at-point (&optional arg) 8427 "Find Wiki Link at point. 8428 With prefix argument ARG, open the file in other window. 8429 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." 8430 (interactive "P") 8431 (if (markdown-wiki-link-p) 8432 (markdown-follow-wiki-link (markdown-wiki-link-link) arg) 8433 (user-error "Point is not at a Wiki Link"))) 8434 8435 (defun markdown-highlight-wiki-link (from to face) 8436 "Highlight the wiki link in the region between FROM and TO using FACE." 8437 (put-text-property from to 'font-lock-face face)) 8438 8439 (defun markdown-unfontify-region-wiki-links (from to) 8440 "Remove wiki link faces from the region specified by FROM and TO." 8441 (interactive "*r") 8442 (let ((modified (buffer-modified-p))) 8443 (remove-text-properties from to '(font-lock-face markdown-link-face)) 8444 (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) 8445 ;; remove-text-properties marks the buffer modified in emacs 24.3, 8446 ;; undo that if it wasn't originally marked modified 8447 (set-buffer-modified-p modified))) 8448 8449 (defun markdown-fontify-region-wiki-links (from to) 8450 "Search region given by FROM and TO for wiki links and fontify them. 8451 If a wiki link is found check to see if the backing file exists 8452 and highlight accordingly." 8453 (goto-char from) 8454 (save-match-data 8455 (while (re-search-forward markdown-regex-wiki-link to t) 8456 (when (not (markdown-code-block-at-point-p)) 8457 (let ((highlight-beginning (match-beginning 1)) 8458 (highlight-end (match-end 1)) 8459 (file-name 8460 (markdown-convert-wiki-link-to-filename 8461 (markdown-wiki-link-link)))) 8462 (if (condition-case nil (file-exists-p file-name) (error nil)) 8463 (markdown-highlight-wiki-link 8464 highlight-beginning highlight-end 'markdown-link-face) 8465 (markdown-highlight-wiki-link 8466 highlight-beginning highlight-end 'markdown-missing-link-face))))))) 8467 8468 (defun markdown-extend-changed-region (from to) 8469 "Extend region given by FROM and TO so that we can fontify all links. 8470 The region is extended to the first newline before and the first 8471 newline after." 8472 ;; start looking for the first new line before 'from 8473 (goto-char from) 8474 (re-search-backward "\n" nil t) 8475 (let ((new-from (point-min)) 8476 (new-to (point-max))) 8477 (if (not (= (point) from)) 8478 (setq new-from (point))) 8479 ;; do the same thing for the first new line after 'to 8480 (goto-char to) 8481 (re-search-forward "\n" nil t) 8482 (if (not (= (point) to)) 8483 (setq new-to (point))) 8484 (cl-values new-from new-to))) 8485 8486 (defun markdown-check-change-for-wiki-link (from to) 8487 "Check region between FROM and TO for wiki links and re-fontify as needed." 8488 (interactive "*r") 8489 (let* ((modified (buffer-modified-p)) 8490 (buffer-undo-list t) 8491 (inhibit-read-only t) 8492 deactivate-mark 8493 buffer-file-truename) 8494 (unwind-protect 8495 (save-excursion 8496 (save-match-data 8497 (save-restriction 8498 (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 8499 ;; Extend the region to fontify so that it starts 8500 ;; and ends at safe places. 8501 (cl-multiple-value-bind (new-from new-to) 8502 (markdown-extend-changed-region from to) 8503 (goto-char new-from) 8504 ;; Only refontify when the range contains text with a 8505 ;; wiki link face or if the wiki link regexp matches. 8506 (when (or (markdown-range-property-any 8507 new-from new-to 'font-lock-face 8508 '(markdown-link-face markdown-missing-link-face)) 8509 (re-search-forward 8510 markdown-regex-wiki-link new-to t)) 8511 ;; Unfontify existing fontification (start from scratch) 8512 (markdown-unfontify-region-wiki-links new-from new-to) 8513 ;; Now do the fontification. 8514 (markdown-fontify-region-wiki-links new-from new-to)))))) 8515 (cursor-intangible-mode -1) 8516 (and (not modified) 8517 (buffer-modified-p) 8518 (set-buffer-modified-p nil))))) 8519 8520 (defun markdown-check-change-for-wiki-link-after-change (from to _) 8521 "Check region between FROM and TO for wiki links and re-fontify as needed. 8522 Designed to be used with the `after-change-functions' hook." 8523 (markdown-check-change-for-wiki-link from to)) 8524 8525 (defun markdown-fontify-buffer-wiki-links () 8526 "Refontify all wiki links in the buffer." 8527 (interactive) 8528 (markdown-check-change-for-wiki-link (point-min) (point-max))) 8529 8530 (defun markdown-toggle-wiki-links (&optional arg) 8531 "Toggle support for wiki links. 8532 With a prefix argument ARG, enable wiki link support if ARG is positive, 8533 and disable it otherwise." 8534 (interactive (list (or current-prefix-arg 'toggle))) 8535 (setq markdown-enable-wiki-links 8536 (if (eq arg 'toggle) 8537 (not markdown-enable-wiki-links) 8538 (> (prefix-numeric-value arg) 0))) 8539 (when (called-interactively-p 'interactive) 8540 (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) 8541 (markdown-reload-extensions)) 8542 8543 (defun markdown-setup-wiki-link-hooks () 8544 "Add or remove hooks for fontifying wiki links. 8545 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." 8546 ;; Anytime text changes make sure it gets fontified correctly 8547 (if (and markdown-enable-wiki-links 8548 markdown-wiki-link-fontify-missing) 8549 (add-hook 'after-change-functions 8550 #'markdown-check-change-for-wiki-link-after-change t t) 8551 (remove-hook 'after-change-functions 8552 #'markdown-check-change-for-wiki-link-after-change t)) 8553 ;; If we left the buffer there is a really good chance we were 8554 ;; creating one of the wiki link documents. Make sure we get 8555 ;; refontified when we come back. 8556 (if (and markdown-enable-wiki-links 8557 markdown-wiki-link-fontify-missing) 8558 (progn 8559 (add-hook 'window-configuration-change-hook 8560 #'markdown-fontify-buffer-wiki-links t t) 8561 (markdown-fontify-buffer-wiki-links)) 8562 (remove-hook 'window-configuration-change-hook 8563 #'markdown-fontify-buffer-wiki-links t) 8564 (markdown-unfontify-region-wiki-links (point-min) (point-max)))) 8565 8566 8567 ;;; Following & Doing ========================================================= 8568 8569 (defun markdown-follow-thing-at-point (arg) 8570 "Follow thing at point if possible, such as a reference link or wiki link. 8571 Opens inline and reference links in a browser. Opens wiki links 8572 to other files in the current window, or the another window if 8573 ARG is non-nil. 8574 See `markdown-follow-link-at-point' and 8575 `markdown-follow-wiki-link-at-point'." 8576 (interactive "P") 8577 (cond ((markdown-link-p) 8578 (markdown-follow-link-at-point)) 8579 ((markdown-wiki-link-p) 8580 (markdown-follow-wiki-link-at-point arg)) 8581 (t 8582 (let* ((values (markdown-link-at-pos (point))) 8583 (url (nth 3 values))) 8584 (unless url 8585 (user-error "Nothing to follow at point")) 8586 (markdown--browse-url url))))) 8587 8588 (defun markdown-do () 8589 "Do something sensible based on context at point. 8590 Jumps between reference links and definitions; between footnote 8591 markers and footnote text." 8592 (interactive) 8593 (cond 8594 ;; Footnote definition 8595 ((markdown-footnote-text-positions) 8596 (markdown-footnote-return)) 8597 ;; Footnote marker 8598 ((markdown-footnote-marker-positions) 8599 (markdown-footnote-goto-text)) 8600 ;; Reference link 8601 ((thing-at-point-looking-at markdown-regex-link-reference) 8602 (markdown-reference-goto-definition)) 8603 ;; Reference definition 8604 ((thing-at-point-looking-at markdown-regex-reference-definition) 8605 (markdown-reference-goto-link (match-string-no-properties 2))) 8606 ;; Link 8607 ((or (markdown-link-p) (markdown-wiki-link-p)) 8608 (markdown-follow-thing-at-point nil)) 8609 ;; GFM task list item 8610 ((markdown-gfm-task-list-item-at-point) 8611 (markdown-toggle-gfm-checkbox)) 8612 ;; Align table 8613 ((markdown-table-at-point-p) 8614 (call-interactively #'markdown-table-align)) 8615 ;; Otherwise 8616 (t 8617 (markdown-insert-gfm-checkbox)))) 8618 8619 8620 ;;; Miscellaneous ============================================================= 8621 8622 (defun markdown-compress-whitespace-string (str) 8623 "Compress whitespace in STR and return result. 8624 Leading and trailing whitespace is removed. Sequences of multiple 8625 spaces, tabs, and newlines are replaced with single spaces." 8626 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" 8627 (replace-regexp-in-string "[ \t\n]+" " " str))) 8628 8629 (defun markdown--substitute-command-keys (string) 8630 "Like `substitute-command-keys' but, but prefers control characters. 8631 First pass STRING to `substitute-command-keys' and then 8632 substitute `C-i` for `TAB` and `C-m` for `RET`." 8633 (replace-regexp-in-string 8634 "\\<TAB\\>" "C-i" 8635 (replace-regexp-in-string 8636 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) 8637 8638 (defun markdown-line-number-at-pos (&optional pos) 8639 "Return (narrowed) buffer line number at position POS. 8640 If POS is nil, use current buffer location. 8641 This is an exact copy of `line-number-at-pos' for use in emacs21." 8642 (let ((opoint (or pos (point))) start) 8643 (save-excursion 8644 (goto-char (point-min)) 8645 (setq start (point)) 8646 (goto-char opoint) 8647 (forward-line 0) 8648 (1+ (count-lines start (point)))))) 8649 8650 (defun markdown-inside-link-p () 8651 "Return t if point is within a link." 8652 (save-match-data 8653 (thing-at-point-looking-at (markdown-make-regex-link-generic)))) 8654 8655 (defun markdown-line-is-reference-definition-p () 8656 "Return whether the current line is a (non-footnote) reference definition." 8657 (save-excursion 8658 (move-beginning-of-line 1) 8659 (and (looking-at-p markdown-regex-reference-definition) 8660 (not (looking-at-p "[ \t]*\\[^"))))) 8661 8662 (defun markdown-adaptive-fill-function () 8663 "Return prefix for filling paragraph or nil if not determined." 8664 (cond 8665 ;; List item inside blockquote 8666 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") 8667 (replace-regexp-in-string 8668 "[0-9\\.*+-]" " " (match-string-no-properties 0))) 8669 ;; Blockquote 8670 ((looking-at markdown-regex-blockquote) 8671 (buffer-substring-no-properties (match-beginning 0) (match-end 2))) 8672 ;; List items 8673 ((looking-at markdown-regex-list) 8674 (match-string-no-properties 0)) 8675 ;; Footnote definition 8676 ((looking-at-p markdown-regex-footnote-definition) 8677 " ") ; four spaces 8678 ;; No match 8679 (t nil))) 8680 8681 (defun markdown-fill-paragraph (&optional justify) 8682 "Fill paragraph at or after point. 8683 This function is like \\[fill-paragraph], but it skips Markdown 8684 code blocks. If the point is in a code block, or just before one, 8685 do not fill. Otherwise, call `fill-paragraph' as usual. If 8686 JUSTIFY is non-nil, justify text as well. Since this function 8687 handles filling itself, it always returns t so that 8688 `fill-paragraph' doesn't run." 8689 (interactive "P") 8690 (unless (or (markdown-code-block-at-point-p) 8691 (save-excursion 8692 (back-to-indentation) 8693 (skip-syntax-forward "-") 8694 (markdown-code-block-at-point-p))) 8695 (let ((fill-prefix (save-excursion 8696 (goto-char (line-beginning-position)) 8697 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") 8698 (match-string-no-properties 1))))) 8699 (fill-paragraph justify))) 8700 t) 8701 8702 (defun markdown-fill-forward-paragraph (&optional arg) 8703 "Function used by `fill-paragraph' to move over ARG paragraphs. 8704 This is a `fill-forward-paragraph-function' for `markdown-mode'. 8705 It is called with a single argument specifying the number of 8706 paragraphs to move. Just like `forward-paragraph', it should 8707 return the number of paragraphs left to move." 8708 (or arg (setq arg 1)) 8709 (if (> arg 0) 8710 ;; With positive ARG, move across ARG non-code-block paragraphs, 8711 ;; one at a time. When passing a code block, don't decrement ARG. 8712 (while (and (not (eobp)) 8713 (> arg 0) 8714 (= (forward-paragraph 1) 0) 8715 (or (markdown-code-block-at-pos (line-beginning-position 0)) 8716 (setq arg (1- arg))))) 8717 ;; Move backward by one paragraph with negative ARG (always -1). 8718 (let ((start (point))) 8719 (setq arg (forward-paragraph arg)) 8720 (while (and (not (eobp)) 8721 (progn (move-to-left-margin) (not (eobp))) 8722 (looking-at-p paragraph-separate)) 8723 (forward-line 1)) 8724 (cond 8725 ;; Move point past whitespace following list marker. 8726 ((looking-at markdown-regex-list) 8727 (goto-char (match-end 0))) 8728 ;; Move point past whitespace following pipe at beginning of line 8729 ;; to handle Pandoc line blocks. 8730 ((looking-at "^|\\s-*") 8731 (goto-char (match-end 0))) 8732 ;; Return point if the paragraph passed was a code block. 8733 ((markdown-code-block-at-pos (line-beginning-position 2)) 8734 (goto-char start))))) 8735 arg) 8736 8737 (defun markdown--inhibit-electric-quote () 8738 "Function added to `electric-quote-inhibit-functions'. 8739 Return non-nil if the quote has been inserted inside a code block 8740 or span." 8741 (let ((pos (1- (point)))) 8742 (or (markdown-inline-code-at-pos pos) 8743 (markdown-code-block-at-pos pos)))) 8744 8745 8746 ;;; Extension Framework ======================================================= 8747 8748 (defun markdown-reload-extensions () 8749 "Check settings, update font-lock keywords and hooks, and re-fontify buffer." 8750 (interactive) 8751 (when (derived-mode-p 'markdown-mode) 8752 ;; Refontify buffer 8753 (font-lock-flush) 8754 ;; Add or remove hooks related to extensions 8755 (markdown-setup-wiki-link-hooks))) 8756 8757 (defun markdown-handle-local-variables () 8758 "Run in `hack-local-variables-hook' to update font lock rules. 8759 Checks to see if there is actually a ‘markdown-mode’ file local variable 8760 before regenerating font-lock rules for extensions." 8761 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) 8762 (assoc 'markdown-enable-math file-local-variables-alist)) 8763 (when (assoc 'markdown-enable-math file-local-variables-alist) 8764 (markdown-toggle-math markdown-enable-math)) 8765 (markdown-reload-extensions))) 8766 8767 8768 ;;; Math Support ============================================================== 8769 8770 (defconst markdown-mode-font-lock-keywords-math 8771 (list 8772 ;; Equation reference (eq:foo) 8773 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) 8774 (2 markdown-reference-face) 8775 (3 markdown-markup-face))) 8776 ;; Equation reference \eqref{foo} 8777 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) 8778 (2 markdown-reference-face) 8779 (3 markdown-markup-face)))) 8780 "Font lock keywords to add and remove when toggling math support.") 8781 8782 (defun markdown-toggle-math (&optional arg) 8783 "Toggle support for inline and display LaTeX math expressions. 8784 With a prefix argument ARG, enable math mode if ARG is positive, 8785 and disable it otherwise. If called from Lisp, enable the mode 8786 if ARG is omitted or nil." 8787 (interactive (list (or current-prefix-arg 'toggle))) 8788 (setq markdown-enable-math 8789 (if (eq arg 'toggle) 8790 (not markdown-enable-math) 8791 (> (prefix-numeric-value arg) 0))) 8792 (if markdown-enable-math 8793 (font-lock-add-keywords 8794 'markdown-mode markdown-mode-font-lock-keywords-math) 8795 (font-lock-remove-keywords 8796 'markdown-mode markdown-mode-font-lock-keywords-math)) 8797 (when (called-interactively-p 'interactive) 8798 (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) 8799 (markdown-reload-extensions)) 8800 8801 8802 ;;; GFM Checkboxes ============================================================ 8803 8804 (define-button-type 'markdown-gfm-checkbox-button 8805 'follow-link t 8806 'face 'markdown-gfm-checkbox-face 8807 'mouse-face 'markdown-highlight-face 8808 'action #'markdown-toggle-gfm-checkbox-button) 8809 8810 (defun markdown-gfm-task-list-item-at-point (&optional bounds) 8811 "Return non-nil if there is a GFM task list item at the point. 8812 Optionally, the list item BOUNDS may be given if available, as 8813 returned by `markdown-cur-list-item-bounds'. When a task list item 8814 is found, the return value is the same value returned by 8815 `markdown-cur-list-item-bounds'." 8816 (unless bounds 8817 (setq bounds (markdown-cur-list-item-bounds))) 8818 (> (length (nth 5 bounds)) 0)) 8819 8820 (defun markdown-insert-gfm-checkbox () 8821 "Add GFM checkbox at point. 8822 Returns t if added. 8823 Returns nil if non-applicable." 8824 (interactive) 8825 (let ((bounds (markdown-cur-list-item-bounds))) 8826 (if bounds 8827 (unless (cl-sixth bounds) 8828 (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) 8829 (markup "[ ] ")) 8830 (if (< pos (point)) 8831 (save-excursion 8832 (goto-char pos) 8833 (insert markup)) 8834 (goto-char pos) 8835 (insert markup)) 8836 (syntax-propertize (+ (cl-second bounds) 4)) 8837 t)) 8838 (unless (save-excursion 8839 (back-to-indentation) 8840 (or (markdown-list-item-at-point-p) 8841 (markdown-heading-at-point) 8842 (markdown-in-comment-p) 8843 (markdown-code-block-at-point-p))) 8844 (let ((pos (save-excursion 8845 (back-to-indentation) 8846 (point))) 8847 (markup (concat (or (save-excursion 8848 (beginning-of-line 0) 8849 (cl-fifth (markdown-cur-list-item-bounds))) 8850 markdown-unordered-list-item-prefix) 8851 "[ ] "))) 8852 (if (< pos (point)) 8853 (save-excursion 8854 (goto-char pos) 8855 (insert markup)) 8856 (goto-char pos) 8857 (insert markup)) 8858 (syntax-propertize (line-end-position)) 8859 t))))) 8860 8861 (defun markdown-toggle-gfm-checkbox () 8862 "Toggle GFM checkbox at point. 8863 Returns the resulting status as a string, either \"[x]\" or \"[ ]\". 8864 Returns nil if there is no task list item at the point." 8865 (interactive) 8866 (save-match-data 8867 (save-excursion 8868 (let ((bounds (markdown-cur-list-item-bounds))) 8869 (when bounds 8870 ;; Move to beginning of task list item 8871 (goto-char (cl-first bounds)) 8872 ;; Advance to column of first non-whitespace after marker 8873 (forward-char (cl-fourth bounds)) 8874 (cond ((looking-at "\\[ \\]") 8875 (replace-match 8876 (if markdown-gfm-uppercase-checkbox "[X]" "[x]") 8877 nil t) 8878 (match-string-no-properties 0)) 8879 ((looking-at "\\[[xX]\\]") 8880 (replace-match "[ ]" nil t) 8881 (match-string-no-properties 0)))))))) 8882 8883 (defun markdown-toggle-gfm-checkbox-button (button) 8884 "Toggle GFM checkbox BUTTON on click." 8885 (save-match-data 8886 (save-excursion 8887 (goto-char (button-start button)) 8888 (markdown-toggle-gfm-checkbox)))) 8889 8890 (defun markdown-make-gfm-checkboxes-buttons (start end) 8891 "Make GFM checkboxes buttons in region between START and END." 8892 (save-excursion 8893 (goto-char start) 8894 (let ((case-fold-search t)) 8895 (save-excursion 8896 (while (re-search-forward markdown-regex-gfm-checkbox end t) 8897 (make-button (match-beginning 1) (match-end 1) 8898 :type 'markdown-gfm-checkbox-button)))))) 8899 8900 ;; Called when any modification is made to buffer text. 8901 (defun markdown-gfm-checkbox-after-change-function (beg end _) 8902 "Add to `after-change-functions' to setup GFM checkboxes as buttons. 8903 BEG and END are the limits of scanned region." 8904 (save-excursion 8905 (save-match-data 8906 ;; Rescan between start of line from `beg' and start of line after `end'. 8907 (markdown-make-gfm-checkboxes-buttons 8908 (progn (goto-char beg) (beginning-of-line) (point)) 8909 (progn (goto-char end) (forward-line 1) (point)))))) 8910 8911 (defun markdown-remove-gfm-checkbox-overlays () 8912 "Remove all GFM checkbox overlays in buffer." 8913 (save-excursion 8914 (save-restriction 8915 (widen) 8916 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) 8917 8918 8919 ;;; Display inline image ====================================================== 8920 8921 (defvar-local markdown-inline-image-overlays nil) 8922 8923 (defun markdown-remove-inline-images () 8924 "Remove inline image overlays from image links in the buffer. 8925 This can be toggled with `markdown-toggle-inline-images' 8926 or \\[markdown-toggle-inline-images]." 8927 (interactive) 8928 (mapc #'delete-overlay markdown-inline-image-overlays) 8929 (setq markdown-inline-image-overlays nil) 8930 (when (fboundp 'clear-image-cache) (clear-image-cache))) 8931 8932 (defcustom markdown-display-remote-images nil 8933 "If non-nil, download and display remote images. 8934 See also `markdown-inline-image-overlays'. 8935 8936 Only image URLs specified with a protocol listed in 8937 `markdown-remote-image-protocols' are displayed." 8938 :group 'markdown 8939 :type 'boolean) 8940 8941 (defcustom markdown-remote-image-protocols '("https") 8942 "List of protocols to use to download remote images. 8943 See also `markdown-display-remote-images'." 8944 :group 'markdown 8945 :type '(repeat string)) 8946 8947 (defvar markdown--remote-image-cache 8948 (make-hash-table :test 'equal) 8949 "A map from URLs to image paths.") 8950 8951 (defun markdown--get-remote-image (url) 8952 "Retrieve the image path for a given URL." 8953 (or (gethash url markdown--remote-image-cache) 8954 (let ((dl-path (make-temp-file "markdown-mode--image"))) 8955 (require 'url) 8956 (url-copy-file url dl-path t) 8957 (puthash url dl-path markdown--remote-image-cache)))) 8958 8959 (defun markdown-display-inline-images () 8960 "Add inline image overlays to image links in the buffer. 8961 This can be toggled with `markdown-toggle-inline-images' 8962 or \\[markdown-toggle-inline-images]." 8963 (interactive) 8964 (unless (display-images-p) 8965 (error "Cannot show images")) 8966 (save-excursion 8967 (save-restriction 8968 (widen) 8969 (goto-char (point-min)) 8970 (while (re-search-forward markdown-regex-link-inline nil t) 8971 (let* ((start (match-beginning 0)) 8972 (imagep (match-beginning 1)) 8973 (end (match-end 0)) 8974 (file (match-string-no-properties 6))) 8975 (when (and imagep 8976 (not (zerop (length file)))) 8977 (unless (file-exists-p file) 8978 (let* ((download-file (funcall markdown-translate-filename-function file)) 8979 (valid-url (ignore-errors 8980 (member (downcase (url-type (url-generic-parse-url download-file))) 8981 markdown-remote-image-protocols)))) 8982 (if (and markdown-display-remote-images valid-url) 8983 (setq file (markdown--get-remote-image download-file)) 8984 (when (not valid-url) 8985 ;; strip query parameter 8986 (setq file (replace-regexp-in-string "?.+\\'" "" file)) 8987 (unless (file-exists-p file) 8988 (setq file (url-unhex-string file))))))) 8989 (when (file-exists-p file) 8990 (let* ((abspath (if (file-name-absolute-p file) 8991 file 8992 (concat default-directory file))) 8993 (image 8994 (cond ((and markdown-max-image-size 8995 (image-type-available-p 'imagemagick)) 8996 (create-image 8997 abspath 'imagemagick nil 8998 :max-width (car markdown-max-image-size) 8999 :max-height (cdr markdown-max-image-size))) 9000 (markdown-max-image-size 9001 (create-image abspath nil nil 9002 :max-width (car markdown-max-image-size) 9003 :max-height (cdr markdown-max-image-size))) 9004 (t (create-image abspath))))) 9005 (when image 9006 (let ((ov (make-overlay start end))) 9007 (overlay-put ov 'display image) 9008 (overlay-put ov 'face 'default) 9009 (push ov markdown-inline-image-overlays))))))))))) 9010 9011 (defun markdown-toggle-inline-images () 9012 "Toggle inline image overlays in the buffer." 9013 (interactive) 9014 (if markdown-inline-image-overlays 9015 (markdown-remove-inline-images) 9016 (markdown-display-inline-images))) 9017 9018 9019 ;;; GFM Code Block Fontification ============================================== 9020 9021 (defcustom markdown-fontify-code-blocks-natively nil 9022 "When non-nil, fontify code in code blocks using the native major mode. 9023 This only works for fenced code blocks where the language is 9024 specified where we can automatically determine the appropriate 9025 mode to use. The language to mode mapping may be customized by 9026 setting the variable `markdown-code-lang-modes'." 9027 :group 'markdown 9028 :type 'boolean 9029 :safe #'booleanp 9030 :package-version '(markdown-mode . "2.3")) 9031 9032 (defcustom markdown-fontify-code-block-default-mode nil 9033 "Default mode to use to fontify code blocks. 9034 This mode is used when automatic detection fails, such as for GFM 9035 code blocks with no language specified." 9036 :group 'markdown 9037 :type '(choice function (const :tag "None" nil)) 9038 :package-version '(markdown-mode . "2.4")) 9039 9040 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg) 9041 "Toggle the native fontification of code blocks. 9042 With a prefix argument ARG, enable if ARG is positive, 9043 and disable otherwise." 9044 (interactive (list (or current-prefix-arg 'toggle))) 9045 (setq markdown-fontify-code-blocks-natively 9046 (if (eq arg 'toggle) 9047 (not markdown-fontify-code-blocks-natively) 9048 (> (prefix-numeric-value arg) 0))) 9049 (when (called-interactively-p 'interactive) 9050 (message "markdown-mode native code block fontification %s" 9051 (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) 9052 (markdown-reload-extensions)) 9053 9054 ;; This is based on `org-src-lang-modes' from org-src.el 9055 (defcustom markdown-code-lang-modes 9056 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) 9057 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) 9058 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) 9059 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) 9060 ("bash" . sh-mode)) 9061 "Alist mapping languages to their major mode. 9062 The key is the language name, the value is the major mode. For 9063 many languages this is simple, but for language where this is not 9064 the case, this variable provides a way to simplify things on the 9065 user side. For example, there is no ocaml-mode in Emacs, but the 9066 mode to use is `tuareg-mode'." 9067 :group 'markdown 9068 :type '(repeat 9069 (cons 9070 (string "Language name") 9071 (symbol "Major mode"))) 9072 :package-version '(markdown-mode . "2.3")) 9073 9074 (defun markdown-get-lang-mode (lang) 9075 "Return major mode that should be used for LANG. 9076 LANG is a string, and the returned major mode is a symbol." 9077 (cl-find-if 9078 #'markdown--lang-mode-predicate 9079 (nconc (list (cdr (assoc lang markdown-code-lang-modes)) 9080 (cdr (assoc (downcase lang) markdown-code-lang-modes))) 9081 (and (fboundp 'treesit-language-available-p) 9082 (list (and (treesit-language-available-p (intern lang)) 9083 (intern (concat lang "-ts-mode"))) 9084 (and (treesit-language-available-p (intern (downcase lang))) 9085 (intern (concat (downcase lang) "-ts-mode"))))) 9086 (list 9087 (intern (concat lang "-mode")) 9088 (intern (concat (downcase lang) "-mode")))))) 9089 9090 (defun markdown--lang-mode-predicate (mode) 9091 (and mode 9092 (fboundp mode) 9093 (or 9094 ;; https://github.com/jrblevin/markdown-mode/issues/787 9095 ;; major-mode-remap-alist was introduced at Emacs 29.1 9096 (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) 9097 for func = (cdr pair) 9098 thereis (and (atom func) (eq mode func))) 9099 ;; https://github.com/jrblevin/markdown-mode/issues/761 9100 (cl-loop for pair in auto-mode-alist 9101 for func = (cdr pair) 9102 thereis (and (atom func) (eq mode func)))))) 9103 9104 (defun markdown-fontify-code-blocks-generic (matcher last) 9105 "Add text properties to next code block from point to LAST. 9106 Use matching function MATCHER." 9107 (when (funcall matcher last) 9108 (save-excursion 9109 (save-match-data 9110 (let* ((start (match-beginning 0)) 9111 (end (match-end 0)) 9112 ;; Find positions outside opening and closing backquotes. 9113 (bol-prev (progn (goto-char start) 9114 (if (bolp) (line-beginning-position 0) (line-beginning-position)))) 9115 (eol-next (progn (goto-char end) 9116 (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) 9117 lang) 9118 (if (and markdown-fontify-code-blocks-natively 9119 (or (setq lang (markdown-code-block-lang)) 9120 markdown-fontify-code-block-default-mode)) 9121 (markdown-fontify-code-block-natively lang start end) 9122 (add-text-properties start end '(face markdown-pre-face))) 9123 ;; Set background for block as well as opening and closing lines. 9124 (font-lock-append-text-property 9125 bol-prev eol-next 'face 'markdown-code-face) 9126 ;; Set invisible property for lines before and after, including newline. 9127 (add-text-properties bol-prev start '(invisible markdown-markup)) 9128 (add-text-properties end eol-next '(invisible markdown-markup))))) 9129 t)) 9130 9131 (defun markdown-fontify-gfm-code-blocks (last) 9132 "Add text properties to next GFM code block from point to LAST." 9133 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) 9134 9135 (defun markdown-fontify-fenced-code-blocks (last) 9136 "Add text properties to next tilde fenced code block from point to LAST." 9137 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) 9138 9139 ;; Based on `org-src-font-lock-fontify-block' from org-src.el. 9140 (defun markdown-fontify-code-block-natively (lang start end) 9141 "Fontify given GFM or fenced code block. 9142 This function is called by Emacs for automatic fontification when 9143 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the 9144 language used in the block. START and END specify the block 9145 position." 9146 (let ((lang-mode (if lang (markdown-get-lang-mode lang) 9147 markdown-fontify-code-block-default-mode))) 9148 (when (fboundp lang-mode) 9149 (let ((string (buffer-substring-no-properties start end)) 9150 (modified (buffer-modified-p)) 9151 (markdown-buffer (current-buffer)) pos next) 9152 (remove-text-properties start end '(face nil)) 9153 (with-current-buffer 9154 (get-buffer-create 9155 (format " *markdown-code-fontification:%s*" (symbol-name lang-mode))) 9156 ;; Make sure that modification hooks are not inhibited in 9157 ;; the org-src-fontification buffer in case we're called 9158 ;; from `jit-lock-function' (Bug#25132). 9159 (let ((inhibit-modification-hooks nil)) 9160 (delete-region (point-min) (point-max)) 9161 (insert string " ")) ;; so there's a final property change 9162 (unless (eq major-mode lang-mode) (funcall lang-mode)) 9163 (font-lock-ensure) 9164 (setq pos (point-min)) 9165 (while (setq next (next-single-property-change pos 'face)) 9166 (let ((val (get-text-property pos 'face))) 9167 (when val 9168 (put-text-property 9169 (+ start (1- pos)) (1- (+ start next)) 'face 9170 val markdown-buffer))) 9171 (setq pos next))) 9172 (add-text-properties 9173 start end 9174 '(font-lock-fontified t fontified t font-lock-multiline t)) 9175 (set-buffer-modified-p modified))))) 9176 9177 (require 'edit-indirect nil t) 9178 (defvar edit-indirect-guess-mode-function) 9179 (defvar edit-indirect-after-commit-functions) 9180 9181 (defun markdown--edit-indirect-after-commit-function (beg end) 9182 "Corrective logic run on code block content from lines BEG to END. 9183 Restores code block indentation from BEG to END, and ensures trailing newlines 9184 at the END of code blocks." 9185 ;; ensure trailing newlines 9186 (goto-char end) 9187 (unless (eq (char-before) ?\n) 9188 (insert "\n")) 9189 ;; restore code block indentation 9190 (goto-char (- beg 1)) 9191 (let ((block-indentation (current-indentation))) 9192 (when (> block-indentation 0) 9193 (indent-rigidly beg end block-indentation))) 9194 (font-lock-ensure)) 9195 9196 (defun markdown-edit-code-block () 9197 "Edit Markdown code block in an indirect buffer." 9198 (interactive) 9199 (save-excursion 9200 (if (fboundp 'edit-indirect-region) 9201 (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) 9202 (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) 9203 (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) 9204 (if (and begin end) 9205 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) 9206 (lang (markdown-code-block-lang)) 9207 (mode (or (and lang (markdown-get-lang-mode lang)) 9208 markdown-edit-code-block-default-mode)) 9209 (edit-indirect-guess-mode-function 9210 (lambda (_parent-buffer _beg _end) 9211 (funcall mode))) 9212 (indirect-buf (edit-indirect-region begin end 'display-buffer))) 9213 ;; reset `sh-shell' when indirect buffer 9214 (when (and (not (member system-type '(ms-dos windows-nt))) 9215 (member mode '(shell-script-mode sh-mode)) 9216 (member lang (append 9217 (mapcar (lambda (e) (symbol-name (car e))) 9218 sh-ancestor-alist) 9219 '("csh" "rc" "sh")))) 9220 (with-current-buffer indirect-buf 9221 (sh-set-shell lang))) 9222 (when (> indentation 0) ;; un-indent in edit-indirect buffer 9223 (with-current-buffer indirect-buf 9224 (indent-rigidly (point-min) (point-max) (- indentation))))) 9225 (user-error "Not inside a GFM or tilde fenced code block"))) 9226 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") 9227 (progn (package-refresh-contents) 9228 (package-install 'edit-indirect) 9229 (markdown-edit-code-block)))))) 9230 9231 9232 ;;; Table Editing ============================================================= 9233 9234 ;; These functions were originally adapted from `org-table.el'. 9235 9236 ;; General helper functions 9237 9238 (defmacro markdown--with-gensyms (symbols &rest body) 9239 (declare (debug (sexp body)) (indent 1)) 9240 `(let ,(mapcar (lambda (s) 9241 `(,s (make-symbol (concat "--" (symbol-name ',s))))) 9242 symbols) 9243 ,@body)) 9244 9245 (defun markdown--split-string (string &optional separators) 9246 "Splits STRING into substrings at SEPARATORS. 9247 SEPARATORS is a regular expression. If nil it defaults to 9248 `split-string-default-separators'. This version returns no empty 9249 strings if there are matches at the beginning and end of string." 9250 (let ((start 0) notfirst list) 9251 (while (and (string-match 9252 (or separators split-string-default-separators) 9253 string 9254 (if (and notfirst 9255 (= start (match-beginning 0)) 9256 (< start (length string))) 9257 (1+ start) start)) 9258 (< (match-beginning 0) (length string))) 9259 (setq notfirst t) 9260 (or (eq (match-beginning 0) 0) 9261 (and (eq (match-beginning 0) (match-end 0)) 9262 (eq (match-beginning 0) start)) 9263 (push (substring string start (match-beginning 0)) list)) 9264 (setq start (match-end 0))) 9265 (or (eq start (length string)) 9266 (push (substring string start) list)) 9267 (nreverse list))) 9268 9269 (defun markdown--string-width (s) 9270 "Return width of string S. 9271 This version ignores characters with invisibility property 9272 `markdown-markup'." 9273 (let (b) 9274 (when (or (eq t buffer-invisibility-spec) 9275 (member 'markdown-markup buffer-invisibility-spec)) 9276 (while (setq b (text-property-any 9277 0 (length s) 9278 'invisible 'markdown-markup s)) 9279 (setq s (concat 9280 (substring s 0 b) 9281 (substring s (or (next-single-property-change 9282 b 'invisible s) 9283 (length s)))))))) 9284 (string-width s)) 9285 9286 (defun markdown--remove-invisible-markup (s) 9287 "Remove Markdown markup from string S. 9288 This version removes characters with invisibility property 9289 `markdown-markup'." 9290 (let (b) 9291 (while (setq b (text-property-any 9292 0 (length s) 9293 'invisible 'markdown-markup s)) 9294 (setq s (concat 9295 (substring s 0 b) 9296 (substring s (or (next-single-property-change 9297 b 'invisible s) 9298 (length s))))))) 9299 s) 9300 9301 ;; Functions for maintaining tables 9302 9303 (defvar markdown-table-at-point-p-function #'markdown--table-at-point-p 9304 "Function to decide if point is inside a table. 9305 9306 The indirection serves to differentiate between standard markdown 9307 tables and gfm tables which are less strict about the markup.") 9308 9309 (defconst markdown-table-line-regexp "^[ \t]*|" 9310 "Regexp matching any line inside a table.") 9311 9312 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]" 9313 "Regexp matching hline inside a table.") 9314 9315 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" 9316 "Regexp matching dline inside a table.") 9317 9318 (defun markdown-table-at-point-p () 9319 "Return non-nil when point is inside a table." 9320 (funcall markdown-table-at-point-p-function)) 9321 9322 (defun markdown--table-at-point-p () 9323 "Return non-nil when point is inside a table." 9324 (save-excursion 9325 (beginning-of-line) 9326 (and (looking-at-p markdown-table-line-regexp) 9327 (not (markdown-code-block-at-point-p))))) 9328 9329 (defconst gfm-table-line-regexp "^.?*|" 9330 "Regexp matching any line inside a table.") 9331 9332 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+" 9333 "Regexp matching hline inside a table.") 9334 9335 ;; GFM simplified tables syntax is as follows: 9336 ;; - A header line for the column names, this is any text 9337 ;; separated by `|'. 9338 ;; - Followed by a string -|-|- ..., the number of dashes is optional 9339 ;; but must be higher than 1. The number of separators should match 9340 ;; the number of columns. 9341 ;; - Followed by the rows of data, which has the same format as the 9342 ;; header line. 9343 ;; Example: 9344 ;; 9345 ;; foo | bar 9346 ;; ------|--------- 9347 ;; bar | baz 9348 ;; bar | baz 9349 (defun gfm--table-at-point-p () 9350 "Return non-nil when point is inside a gfm-compatible table." 9351 (or (markdown--table-at-point-p) 9352 (save-excursion 9353 (beginning-of-line) 9354 (when (looking-at-p gfm-table-line-regexp) 9355 ;; we might be at the first line of the table, check if the 9356 ;; line below is the hline 9357 (or (save-excursion 9358 (forward-line 1) 9359 (looking-at-p gfm-table-hline-regexp)) 9360 ;; go up to find the header 9361 (catch 'done 9362 (while (looking-at-p gfm-table-line-regexp) 9363 (cond 9364 ((looking-at-p gfm-table-hline-regexp) 9365 (throw 'done t)) 9366 ((bobp) 9367 (throw 'done nil))) 9368 (forward-line -1)) 9369 nil)))))) 9370 9371 (defun markdown-table-hline-at-point-p () 9372 "Return non-nil when point is on a hline in a table. 9373 This function assumes point is on a table." 9374 (save-excursion 9375 (beginning-of-line) 9376 (looking-at-p markdown-table-hline-regexp))) 9377 9378 (defun markdown-table-begin () 9379 "Find the beginning of the table and return its position. 9380 This function assumes point is on a table." 9381 (save-excursion 9382 (while (and (not (bobp)) 9383 (markdown-table-at-point-p)) 9384 (forward-line -1)) 9385 (unless (or (eobp) 9386 (markdown-table-at-point-p)) 9387 (forward-line 1)) 9388 (point))) 9389 9390 (defun markdown-table-end () 9391 "Find the end of the table and return its position. 9392 This function assumes point is on a table." 9393 (save-excursion 9394 (while (and (not (eobp)) 9395 (markdown-table-at-point-p)) 9396 (forward-line 1)) 9397 (point))) 9398 9399 (defun markdown-table-get-dline () 9400 "Return index of the table data line at point. 9401 This function assumes point is on a table." 9402 (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) 9403 (save-excursion 9404 (goto-char (markdown-table-begin)) 9405 (while (and (re-search-forward 9406 markdown-table-dline-regexp end t) 9407 (setq cnt (1+ cnt)) 9408 (< (line-end-position) pos)))) 9409 cnt)) 9410 9411 (defun markdown--thing-at-wiki-link (pos) 9412 (when markdown-enable-wiki-links 9413 (save-excursion 9414 (save-match-data 9415 (goto-char pos) 9416 (thing-at-point-looking-at markdown-regex-wiki-link))))) 9417 9418 (defun markdown-table-get-column () 9419 "Return table column at point. 9420 This function assumes point is on a table." 9421 (let ((pos (point)) (cnt 0)) 9422 (save-excursion 9423 (beginning-of-line) 9424 (while (search-forward "|" pos t) 9425 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9426 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9427 (setq cnt (1+ cnt))))) 9428 cnt)) 9429 9430 (defun markdown-table-get-cell (&optional n) 9431 "Return the content of the cell in column N of current row. 9432 N defaults to column at point. This function assumes point is on 9433 a table." 9434 (and n (markdown-table-goto-column n)) 9435 (skip-chars-backward "^|\n") (backward-char 1) 9436 (if (looking-at "|[^|\r\n]*") 9437 (let* ((pos (match-beginning 0)) 9438 (val (buffer-substring (1+ pos) (match-end 0)))) 9439 (goto-char (min (line-end-position) (+ 2 pos))) 9440 ;; Trim whitespaces 9441 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) 9442 val (replace-regexp-in-string "[ \t]+\\'" "" val))) 9443 (forward-char 1) "")) 9444 9445 (defun markdown-table-goto-dline (n) 9446 "Go to the Nth data line in the table at point. 9447 Return t when the line exists, nil otherwise. This function 9448 assumes point is on a table." 9449 (goto-char (markdown-table-begin)) 9450 (let ((end (markdown-table-end)) (cnt 0)) 9451 (while (and (re-search-forward 9452 markdown-table-dline-regexp end t) 9453 (< (setq cnt (1+ cnt)) n))) 9454 (= cnt n))) 9455 9456 (defun markdown-table-goto-column (n &optional on-delim) 9457 "Go to the Nth column in the table line at point. 9458 With optional argument ON-DELIM, stop with point before the left 9459 delimiter of the cell. If there are less than N cells, just go 9460 beyond the last delimiter. This function assumes point is on a 9461 table." 9462 (beginning-of-line 1) 9463 (when (> n 0) 9464 (while (and (> n 0) (search-forward "|" (line-end-position) t)) 9465 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9466 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9467 (cl-decf n))) 9468 (if on-delim 9469 (backward-char 1) 9470 (when (looking-at " ") (forward-char 1))))) 9471 9472 (defmacro markdown-table-save-cell (&rest body) 9473 "Save cell at point, execute BODY and restore cell. 9474 This function assumes point is on a table." 9475 (declare (debug (body))) 9476 (markdown--with-gensyms (line column) 9477 `(let ((,line (copy-marker (line-beginning-position))) 9478 (,column (markdown-table-get-column))) 9479 (unwind-protect 9480 (progn ,@body) 9481 (goto-char ,line) 9482 (markdown-table-goto-column ,column) 9483 (set-marker ,line nil))))) 9484 9485 (defun markdown-table-blank-line (s) 9486 "Convert a table line S into a line with blank cells." 9487 (if (string-match "^[ \t]*|-" s) 9488 (setq s (mapconcat 9489 (lambda (x) (if (member x '(?| ?+)) "|" " ")) 9490 s "")) 9491 (with-temp-buffer 9492 (insert s) 9493 (goto-char (point-min)) 9494 (when (re-search-forward "|" nil t) 9495 (let ((cur (point)) 9496 ret) 9497 (while (re-search-forward "|" nil t) 9498 (when (and (not (eql (char-before (match-beginning 0)) ?\\)) 9499 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9500 (push (make-string (- (match-beginning 0) cur) ? ) ret) 9501 (setq cur (match-end 0)))) 9502 (format "|%s|" (string-join (nreverse ret) "|"))))))) 9503 9504 (defun markdown-table-colfmt (fmtspec) 9505 "Process column alignment specifier FMTSPEC for tables." 9506 (when (stringp fmtspec) 9507 (mapcar (lambda (x) 9508 (cond ((string-match-p "^:.*:$" x) 'c) 9509 ((string-match-p "^:" x) 'l) 9510 ((string-match-p ":$" x) 'r) 9511 (t 'd))) 9512 (markdown--split-string fmtspec "\\s-*|\\s-*")))) 9513 9514 (defun markdown--first-column-p (bar-pos) 9515 (save-excursion 9516 (save-match-data 9517 (goto-char bar-pos) 9518 (looking-back "^\\s-*" (line-beginning-position))))) 9519 9520 (defun markdown--table-line-to-columns (line) 9521 (with-temp-buffer 9522 (insert line) 9523 (goto-char (point-min)) 9524 (let ((cur (point)) 9525 ret) 9526 (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) 9527 (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) 9528 (if (markdown--first-column-p (match-beginning 1)) 9529 (setq cur (match-end 0)) 9530 (cond ((eql (char-before (match-beginning 1)) ?\\) 9531 ;; keep spaces 9532 (goto-char (match-end 1))) 9533 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing 9534 (t 9535 (push (buffer-substring-no-properties cur (match-beginning 0)) ret) 9536 (setq cur (match-end 0))))))) 9537 (when (< cur (length line)) 9538 (push (buffer-substring-no-properties cur (point-max)) ret)) 9539 (nreverse ret)))) 9540 9541 (defsubst markdown--is-delimiter-row (line) 9542 (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) 9543 (cl-loop for c across line 9544 always (member c '(?| ?- ?: ?\t ? ))))) 9545 9546 (defun markdown-table-align () 9547 "Align table at point. 9548 This function assumes point is on a table." 9549 (interactive) 9550 (let ((begin (markdown-table-begin)) 9551 (end (copy-marker (markdown-table-end)))) 9552 (markdown-table-save-cell 9553 (goto-char begin) 9554 (let* (fmtspec 9555 ;; Store table indent 9556 (indent (progn (looking-at "[ \t]*") (match-string 0))) 9557 ;; Split table in lines and save column format specifier 9558 (lines (mapcar (lambda (line) 9559 (if (markdown--is-delimiter-row line) 9560 (progn (setq fmtspec (or fmtspec line)) nil) 9561 line)) 9562 (markdown--split-string (buffer-substring begin end) "\n"))) 9563 ;; Split lines in cells 9564 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) 9565 (remq nil lines))) 9566 ;; Calculate maximum number of cells in a line 9567 (maxcells (if cells 9568 (apply #'max (mapcar #'length cells)) 9569 (user-error "Empty table"))) 9570 ;; Empty cells to fill short lines 9571 (emptycells (make-list maxcells "")) 9572 maxwidths) 9573 ;; Calculate maximum width for each column 9574 (dotimes (i maxcells) 9575 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) 9576 (push (apply #'max 1 (mapcar #'markdown--string-width column)) 9577 maxwidths))) 9578 (setq maxwidths (nreverse maxwidths)) 9579 ;; Process column format specifier 9580 (setq fmtspec (markdown-table-colfmt fmtspec)) 9581 ;; Compute formats needed for output of table lines 9582 (let ((hfmt (concat indent "|")) 9583 (rfmt (concat indent "|")) 9584 hfmt1 rfmt1 fmt) 9585 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) 9586 (setq fmt (pop fmtspec)) 9587 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) 9588 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) 9589 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) 9590 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) 9591 (setq rfmt (concat rfmt (format rfmt1 width))) 9592 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) 9593 ;; Replace modified lines only 9594 (dolist (line lines) 9595 (let ((line (if line 9596 (apply #'format rfmt (append (pop cells) emptycells)) 9597 hfmt)) 9598 (previous (buffer-substring (point) (line-end-position)))) 9599 (if (equal previous line) 9600 (forward-line) 9601 (insert line "\n") 9602 (delete-region (point) (line-beginning-position 2)))))) 9603 (set-marker end nil))))) 9604 9605 (defun markdown-table-insert-row (&optional arg) 9606 "Insert a new row above the row at point into the table. 9607 With optional argument ARG, insert below the current row." 9608 (interactive "P") 9609 (unless (markdown-table-at-point-p) 9610 (user-error "Not at a table")) 9611 (let* ((line (buffer-substring 9612 (line-beginning-position) (line-end-position))) 9613 (new (markdown-table-blank-line line))) 9614 (beginning-of-line (if arg 2 1)) 9615 (unless (bolp) (insert "\n")) 9616 (insert-before-markers new "\n") 9617 (beginning-of-line 0) 9618 (re-search-forward "| ?" (line-end-position) t))) 9619 9620 (defun markdown-table-delete-row () 9621 "Delete row or horizontal line at point from the table." 9622 (interactive) 9623 (unless (markdown-table-at-point-p) 9624 (user-error "Not at a table")) 9625 (let ((col (current-column))) 9626 (kill-region (line-beginning-position) 9627 (min (1+ (line-end-position)) (point-max))) 9628 (unless (markdown-table-at-point-p) (beginning-of-line 0)) 9629 (move-to-column col))) 9630 9631 (defun markdown-table-move-row (&optional up) 9632 "Move table line at point down. 9633 With optional argument UP, move it up." 9634 (interactive "P") 9635 (unless (markdown-table-at-point-p) 9636 (user-error "Not at a table")) 9637 (let* ((col (current-column)) (pos (point)) 9638 (tonew (if up 0 2)) txt) 9639 (beginning-of-line tonew) 9640 (unless (markdown-table-at-point-p) 9641 (goto-char pos) (user-error "Cannot move row further")) 9642 (goto-char pos) (beginning-of-line 1) (setq pos (point)) 9643 (setq txt (buffer-substring (point) (1+ (line-end-position)))) 9644 (delete-region (point) (1+ (line-end-position))) 9645 (beginning-of-line tonew) 9646 (insert txt) (beginning-of-line 0) 9647 (move-to-column col))) 9648 9649 (defun markdown-table-move-row-up () 9650 "Move table row at point up." 9651 (interactive) 9652 (markdown-table-move-row 'up)) 9653 9654 (defun markdown-table-move-row-down () 9655 "Move table row at point down." 9656 (interactive) 9657 (markdown-table-move-row nil)) 9658 9659 (defun markdown-table-insert-column () 9660 "Insert a new table column." 9661 (interactive) 9662 (unless (markdown-table-at-point-p) 9663 (user-error "Not at a table")) 9664 (let* ((col (max 1 (markdown-table-get-column))) 9665 (begin (markdown-table-begin)) 9666 (end (copy-marker (markdown-table-end)))) 9667 (markdown-table-save-cell 9668 (goto-char begin) 9669 (while (< (point) end) 9670 (markdown-table-goto-column col t) 9671 (if (markdown-table-hline-at-point-p) 9672 (insert "|---") 9673 (insert "| ")) 9674 (forward-line))) 9675 (set-marker end nil) 9676 (when markdown-table-align-p 9677 (markdown-table-align)))) 9678 9679 (defun markdown-table-delete-column () 9680 "Delete column at point from table." 9681 (interactive) 9682 (unless (markdown-table-at-point-p) 9683 (user-error "Not at a table")) 9684 (let ((col (markdown-table-get-column)) 9685 (begin (markdown-table-begin)) 9686 (end (copy-marker (markdown-table-end)))) 9687 (markdown-table-save-cell 9688 (goto-char begin) 9689 (while (< (point) end) 9690 (markdown-table-goto-column col t) 9691 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") 9692 (replace-match "|")) 9693 (forward-line))) 9694 (set-marker end nil) 9695 (markdown-table-goto-column (max 1 (1- col))) 9696 (when markdown-table-align-p 9697 (markdown-table-align)))) 9698 9699 (defun markdown-table-move-column (&optional left) 9700 "Move table column at point to the right. 9701 With optional argument LEFT, move it to the left." 9702 (interactive "P") 9703 (unless (markdown-table-at-point-p) 9704 (user-error "Not at a table")) 9705 (let* ((col (markdown-table-get-column)) 9706 (col1 (if left (1- col) col)) 9707 (colpos (if left (1- col) (1+ col))) 9708 (begin (markdown-table-begin)) 9709 (end (copy-marker (markdown-table-end)))) 9710 (when (and left (= col 1)) 9711 (user-error "Cannot move column further left")) 9712 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) 9713 (user-error "Cannot move column further right")) 9714 (markdown-table-save-cell 9715 (goto-char begin) 9716 (while (< (point) end) 9717 (markdown-table-goto-column col1 t) 9718 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") 9719 (replace-match "|\\2|\\1|")) 9720 (forward-line))) 9721 (set-marker end nil) 9722 (markdown-table-goto-column colpos) 9723 (when markdown-table-align-p 9724 (markdown-table-align)))) 9725 9726 (defun markdown-table-move-column-left () 9727 "Move table column at point to the left." 9728 (interactive) 9729 (markdown-table-move-column 'left)) 9730 9731 (defun markdown-table-move-column-right () 9732 "Move table column at point to the right." 9733 (interactive) 9734 (markdown-table-move-column nil)) 9735 9736 (defun markdown-table-next-row () 9737 "Go to the next row (same column) in the table. 9738 Create new table lines if required." 9739 (interactive) 9740 (unless (markdown-table-at-point-p) 9741 (user-error "Not at a table")) 9742 (if (or (looking-at "[ \t]*$") 9743 (save-excursion (skip-chars-backward " \t") (bolp))) 9744 (newline) 9745 (when markdown-table-align-p 9746 (markdown-table-align)) 9747 (let ((col (markdown-table-get-column))) 9748 (beginning-of-line 2) 9749 (if (or (not (markdown-table-at-point-p)) 9750 (markdown-table-hline-at-point-p)) 9751 (progn 9752 (beginning-of-line 0) 9753 (markdown-table-insert-row 'below))) 9754 (markdown-table-goto-column col) 9755 (skip-chars-backward "^|\n\r") 9756 (when (looking-at " ") (forward-char 1))))) 9757 9758 (defun markdown-table-forward-cell () 9759 "Go to the next cell in the table. 9760 Create new table lines if required." 9761 (interactive) 9762 (unless (markdown-table-at-point-p) 9763 (user-error "Not at a table")) 9764 (when markdown-table-align-p 9765 (markdown-table-align)) 9766 (let ((end (markdown-table-end))) 9767 (when (markdown-table-hline-at-point-p) (end-of-line 1)) 9768 (condition-case nil 9769 (progn 9770 (re-search-forward "\\(?:^\\|[^\\]\\)|" end) 9771 (when (looking-at "[ \t]*$") 9772 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) 9773 (when (and (looking-at "[-:]") 9774 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) 9775 (goto-char (match-beginning 1))) 9776 (if (looking-at "[-:]") 9777 (progn 9778 (beginning-of-line 0) 9779 (markdown-table-insert-row 'below)) 9780 (when (looking-at " ") (forward-char 1)))) 9781 (error (markdown-table-insert-row 'below))))) 9782 9783 (defun markdown-table-backward-cell () 9784 "Go to the previous cell in the table." 9785 (interactive) 9786 (unless (markdown-table-at-point-p) 9787 (user-error "Not at a table")) 9788 (when markdown-table-align-p 9789 (markdown-table-align)) 9790 (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) 9791 (condition-case nil 9792 (progn 9793 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) 9794 ;; When this function is called while in the first cell in a 9795 ;; table, the point will now be at the beginning of a line. In 9796 ;; this case, we need to move past one additional table 9797 ;; boundary, the end of the table on the previous line. 9798 (when (= (point) (line-beginning-position)) 9799 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9800 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9801 (error (user-error "Cannot move to previous table cell"))) 9802 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) 9803 9804 ;; This may have dropped point on the hline. 9805 (when (markdown-table-hline-at-point-p) 9806 (markdown-table-backward-cell))) 9807 9808 (defun markdown-table-transpose () 9809 "Transpose table at point. 9810 Horizontal separator lines will be eliminated." 9811 (interactive) 9812 (unless (markdown-table-at-point-p) 9813 (user-error "Not at a table")) 9814 (let* ((table (buffer-substring-no-properties 9815 (markdown-table-begin) (markdown-table-end))) 9816 ;; Convert table to Lisp structure 9817 (table (delq nil 9818 (mapcar 9819 (lambda (x) 9820 (unless (string-match-p 9821 markdown-table-hline-regexp x) 9822 (markdown--table-line-to-columns x))) 9823 (markdown--split-string table "[ \t]*\n[ \t]*")))) 9824 (dline_old (markdown-table-get-dline)) 9825 (col_old (markdown-table-get-column)) 9826 (contents (mapcar (lambda (_) 9827 (let ((tp table)) 9828 (mapcar 9829 (lambda (_) 9830 (prog1 9831 (pop (car tp)) 9832 (setq tp (cdr tp)))) 9833 table))) 9834 (car table)))) 9835 (goto-char (markdown-table-begin)) 9836 (save-excursion 9837 (re-search-forward "|") (backward-char) 9838 (delete-region (point) (markdown-table-end)) 9839 (insert (mapconcat 9840 (lambda(x) 9841 (concat "| " (mapconcat 'identity x " | " ) " |\n")) 9842 contents ""))) 9843 (markdown-table-goto-dline col_old) 9844 (markdown-table-goto-column dline_old)) 9845 (when markdown-table-align-p 9846 (markdown-table-align))) 9847 9848 (defun markdown-table-sort-lines (&optional sorting-type) 9849 "Sort table lines according to the column at point. 9850 9851 The position of point indicates the column to be used for 9852 sorting, and the range of lines is the range between the nearest 9853 horizontal separator lines, or the entire table of no such lines 9854 exist. If point is before the first column, user will be prompted 9855 for the sorting column. If there is an active region, the mark 9856 specifies the first line and the sorting column, while point 9857 should be in the last line to be included into the sorting. 9858 9859 The command then prompts for the sorting type which can be 9860 alphabetically or numerically. Sorting in reverse order is also 9861 possible. 9862 9863 If SORTING-TYPE is specified when this function is called from a 9864 Lisp program, no prompting will take place. SORTING-TYPE must be 9865 a character, any of (?a ?A ?n ?N) where the capital letters 9866 indicate that sorting should be done in reverse order." 9867 (interactive) 9868 (unless (markdown-table-at-point-p) 9869 (user-error "Not at a table")) 9870 ;; Set sorting type and column used for sorting 9871 (let ((column (let ((c (markdown-table-get-column))) 9872 (cond ((> c 0) c) 9873 ((called-interactively-p 'any) 9874 (read-number "Use column N for sorting: ")) 9875 (t 1)))) 9876 (sorting-type 9877 (or sorting-type 9878 (progn 9879 ;; workaround #641 9880 ;; Emacs < 28 hides prompt message by another message. This erases it. 9881 (message "") 9882 (read-char-exclusive 9883 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) 9884 (save-restriction 9885 ;; Narrow buffer to appropriate sorting area 9886 (if (region-active-p) 9887 (narrow-to-region 9888 (save-excursion 9889 (progn 9890 (goto-char (region-beginning)) (line-beginning-position))) 9891 (save-excursion 9892 (progn 9893 (goto-char (region-end)) (line-end-position)))) 9894 (let ((start (markdown-table-begin)) 9895 (end (markdown-table-end))) 9896 (narrow-to-region 9897 (save-excursion 9898 (if (re-search-backward 9899 markdown-table-hline-regexp start t) 9900 (line-beginning-position 2) 9901 start)) 9902 (if (save-excursion (re-search-forward 9903 markdown-table-hline-regexp end t)) 9904 (match-beginning 0) 9905 end)))) 9906 ;; Determine arguments for `sort-subr' 9907 (let* ((extract-key-from-cell 9908 (cl-case sorting-type 9909 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) 9910 ((?n ?N) #'string-to-number) 9911 (t (user-error "Invalid sorting type: %c" sorting-type)))) 9912 (predicate 9913 (cl-case sorting-type 9914 ((?n ?N) #'<) 9915 ((?a ?A) #'string<)))) 9916 ;; Sort selected area 9917 (goto-char (point-min)) 9918 (sort-subr (memq sorting-type '(?A ?N)) 9919 (lambda () 9920 (forward-line) 9921 (while (and (not (eobp)) 9922 (not (looking-at 9923 markdown-table-dline-regexp))) 9924 (forward-line))) 9925 #'end-of-line 9926 (lambda () 9927 (funcall extract-key-from-cell 9928 (markdown-table-get-cell column))) 9929 nil 9930 predicate) 9931 (goto-char (point-min)))))) 9932 9933 (defun markdown-table-convert-region (begin end &optional separator) 9934 "Convert region from BEGIN to END to table with SEPARATOR. 9935 9936 If every line contains at least one TAB character, the function 9937 assumes that the material is tab separated (TSV). If every line 9938 contains a comma, comma-separated values (CSV) are assumed. If 9939 not, lines are split at whitespace into cells. 9940 9941 You can use a prefix argument to force a specific separator: 9942 \\[universal-argument] once forces CSV, \\[universal-argument] 9943 twice forces TAB, and \\[universal-argument] three times will 9944 prompt for a regular expression to match the separator, and a 9945 numeric argument N indicates that at least N consecutive 9946 spaces, or alternatively a TAB should be used as the separator." 9947 9948 (interactive "r\nP") 9949 (let* ((begin (min begin end)) (end (max begin end)) re) 9950 (goto-char begin) (beginning-of-line 1) 9951 (setq begin (point-marker)) 9952 (goto-char end) 9953 (if (bolp) (backward-char 1) (end-of-line 1)) 9954 (setq end (point-marker)) 9955 (when (equal separator '(64)) 9956 (setq separator (read-regexp "Regexp for cell separator: "))) 9957 (unless separator 9958 ;; Get the right cell separator 9959 (goto-char begin) 9960 (setq separator 9961 (cond 9962 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) 9963 ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) 9964 (t 1)))) 9965 (goto-char begin) 9966 (if (equal separator '(4)) 9967 ;; Parse CSV 9968 (while (< (point) end) 9969 (cond 9970 ((looking-at "^") (insert "| ")) 9971 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) 9972 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") 9973 (replace-match "\\1") (if (looking-at "\"") (insert "\""))) 9974 ((looking-at "[^,\n]+") (goto-char (match-end 0))) 9975 ((looking-at "[ \t]*,") (replace-match " | ")) 9976 (t (beginning-of-line 2)))) 9977 (setq re 9978 (cond 9979 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") 9980 ((equal separator '(16)) "^\\|\t") 9981 ((integerp separator) 9982 (if (< separator 1) 9983 (user-error "Cell separator must contain one or more spaces") 9984 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) 9985 ((stringp separator) (format "^ *\\|%s" separator)) 9986 (t (error "Invalid cell separator")))) 9987 (let (finish) 9988 (while (and (not finish) (re-search-forward re end t)) 9989 (if (eolp) 9990 (progn 9991 (replace-match "|" t t) 9992 (forward-line 1) 9993 (when (eobp) 9994 (setq finish t))) 9995 (replace-match "| " t t))))) 9996 (goto-char begin) 9997 (when markdown-table-align-p 9998 (markdown-table-align)))) 9999 10000 (defun markdown-insert-table (&optional rows columns align) 10001 "Insert an empty pipe table. 10002 Optional arguments ROWS, COLUMNS, and ALIGN specify number of 10003 rows and columns and the column alignment." 10004 (interactive) 10005 (let* ((rows (or rows (read-number "Number of Rows: "))) 10006 (columns (or columns (read-number "Number of Columns: "))) 10007 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) 10008 (align (cond ((equal align "l") ":--") 10009 ((equal align "r") "--:") 10010 ((equal align "c") ":-:") 10011 (t "---"))) 10012 (pos (point)) 10013 (indent (make-string (current-column) ?\ )) 10014 (line (concat 10015 (apply 'concat indent "|" 10016 (make-list columns " |")) "\n")) 10017 (hline (apply 'concat indent "|" 10018 (make-list columns (concat align "|"))))) 10019 (if (string-match 10020 "^[ \t]*$" (buffer-substring-no-properties 10021 (line-beginning-position) (point))) 10022 (beginning-of-line 1) 10023 (newline)) 10024 (dotimes (_ rows) (insert line)) 10025 (goto-char pos) 10026 (if (> rows 1) 10027 (progn 10028 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) 10029 (markdown-table-forward-cell))) 10030 10031 10032 ;;; ElDoc Support ============================================================= 10033 10034 (defun markdown-eldoc-function (&rest _ignored) 10035 "Return a helpful string when appropriate based on context. 10036 * Report URL when point is at a hidden URL. 10037 * Report language name when point is a code block with hidden markup." 10038 (cond 10039 ;; Hidden URL or reference for inline link 10040 ((and (or (thing-at-point-looking-at markdown-regex-link-inline) 10041 (thing-at-point-looking-at markdown-regex-link-reference)) 10042 (or markdown-hide-urls markdown-hide-markup)) 10043 (let* ((imagep (string-equal (match-string 1) "!")) 10044 (referencep (string-equal (match-string 5) "[")) 10045 (link (match-string-no-properties 6)) 10046 (edit-keys (markdown--substitute-command-keys 10047 (if imagep 10048 "\\[markdown-insert-image]" 10049 "\\[markdown-insert-link]"))) 10050 (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) 10051 (object (if referencep "reference" "URL"))) 10052 (format "Hidden %s (%s to edit): %s" object edit-str 10053 (if referencep 10054 (concat 10055 (propertize "[" 'face 'markdown-markup-face) 10056 (propertize link 'face 'markdown-reference-face) 10057 (propertize "]" 'face 'markdown-markup-face)) 10058 (propertize link 'face 'markdown-url-face))))) 10059 ;; Hidden language name for fenced code blocks 10060 ((and (markdown-code-block-at-point-p) 10061 (not (get-text-property (point) 'markdown-pre)) 10062 markdown-hide-markup) 10063 (let ((lang (save-excursion (markdown-code-block-lang)))) 10064 (unless lang (setq lang "[unspecified]")) 10065 (format "Hidden code block language: %s (%s to toggle markup)" 10066 (propertize lang 'face 'markdown-language-keyword-face) 10067 (markdown--substitute-command-keys 10068 "\\[markdown-toggle-markup-hiding]")))))) 10069 10070 (defun markdown--image-media-handler (mimetype data) 10071 (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) 10072 (filename (read-string "Insert filename for image: ")) 10073 (link-text (read-string "Link text: ")) 10074 (filepath (file-name-with-extension filename ext)) 10075 (dir (file-name-directory filepath))) 10076 (when (and dir (not (file-directory-p dir))) 10077 (make-directory dir t)) 10078 (with-temp-file filepath 10079 (insert data)) 10080 (when (string-match-p "\\s-" filepath) 10081 (setq filepath (concat "<" filepath ">"))) 10082 (markdown-insert-inline-image link-text filepath))) 10083 10084 (defun markdown--file-media-handler (_mimetype data) 10085 (let* ((data (split-string data "[\0\r\n]" t "^file://")) 10086 (files (cdr data))) 10087 (while (not (null files)) 10088 (let* ((file (url-unhex-string (car files))) 10089 (file (file-relative-name file)) 10090 (prompt (format "Link text(%s): " (file-name-nondirectory file))) 10091 (link-text (read-string prompt))) 10092 (when (string-match-p "\\s-" file) 10093 (setq file (concat "<" file ">"))) 10094 (markdown-insert-inline-image link-text file) 10095 (when (not (null (cdr files))) 10096 (insert " ")) 10097 (setq files (cdr files)))))) 10098 10099 (defun markdown--dnd-local-file-handler (url _action) 10100 (require 'mailcap) 10101 (require 'dnd) 10102 (let* ((filename (dnd-get-local-file-name url)) 10103 (mimetype (mailcap-file-name-to-mime-type filename)) 10104 (file (file-relative-name filename)) 10105 (link-text "link text")) 10106 (when (string-match-p "\\s-" file) 10107 (setq file (concat "<" file ">"))) 10108 (if (string-prefix-p "image/" mimetype) 10109 (markdown-insert-inline-image link-text file) 10110 (markdown-insert-inline-link link-text file)))) 10111 10112 10113 ;;; Mode Definition ========================================================== 10114 10115 (defun markdown-show-version () 10116 "Show the version number in the minibuffer." 10117 (interactive) 10118 (message "markdown-mode, version %s" markdown-mode-version)) 10119 10120 (defun markdown-mode-info () 10121 "Open the `markdown-mode' homepage." 10122 (interactive) 10123 (browse-url "https://jblevins.org/projects/markdown-mode/")) 10124 10125 ;;;###autoload 10126 (define-derived-mode markdown-mode text-mode "Markdown" 10127 "Major mode for editing Markdown files." 10128 (when buffer-read-only 10129 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) 10130 (setq-local buffer-read-only nil))) 10131 ;; Natural Markdown tab width 10132 (setq tab-width 4) 10133 ;; Comments 10134 (setq-local comment-start "<!-- ") 10135 (setq-local comment-end " -->") 10136 (setq-local comment-start-skip "<!--[ \t]*") 10137 (setq-local comment-column 0) 10138 (setq-local comment-auto-fill-only-comments nil) 10139 (setq-local comment-use-syntax t) 10140 ;; Sentence 10141 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") 10142 ;; Syntax 10143 (add-hook 'syntax-propertize-extend-region-functions 10144 #'markdown-syntax-propertize-extend-region nil t) 10145 (add-hook 'jit-lock-after-change-extend-region-functions 10146 #'markdown-font-lock-extend-region-function t t) 10147 (setq-local syntax-propertize-function #'markdown-syntax-propertize) 10148 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. 10149 ;; Font lock. 10150 (setq font-lock-defaults 10151 '(markdown-mode-font-lock-keywords 10152 nil nil nil nil 10153 (font-lock-multiline . t) 10154 (font-lock-syntactic-face-function . markdown-syntactic-face) 10155 (font-lock-extra-managed-props 10156 . (composition display invisible rear-nonsticky 10157 keymap help-echo mouse-face)))) 10158 (if markdown-hide-markup 10159 (add-to-invisibility-spec 'markdown-markup) 10160 (remove-from-invisibility-spec 'markdown-markup)) 10161 ;; Wiki links 10162 (markdown-setup-wiki-link-hooks) 10163 ;; Math mode 10164 (when markdown-enable-math (markdown-toggle-math t)) 10165 ;; Add a buffer-local hook to reload after file-local variables are read 10166 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) 10167 ;; For imenu support 10168 (setq imenu-create-index-function 10169 (if markdown-nested-imenu-heading-index 10170 #'markdown-imenu-create-nested-index 10171 #'markdown-imenu-create-flat-index)) 10172 10173 ;; Defun movement 10174 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) 10175 (setq-local end-of-defun-function #'markdown-end-of-defun) 10176 ;; Paragraph filling 10177 (setq-local fill-paragraph-function #'markdown-fill-paragraph) 10178 (setq-local paragraph-start 10179 ;; Should match start of lines that start or separate paragraphs 10180 (mapconcat #'identity 10181 '( 10182 "\f" ; starts with a literal line-feed 10183 "[ \t\f]*$" ; space-only line 10184 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10185 "[ \t]*[*+-][ \t]+" ; unordered list item 10186 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item 10187 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def 10188 "[ \t]*:[ \t]+" ; definition 10189 "^|" ; table or Pandoc line block 10190 ) 10191 "\\|")) 10192 (setq-local paragraph-separate 10193 ;; Should match lines that separate paragraphs without being 10194 ;; part of any paragraph: 10195 (mapconcat #'identity 10196 '("[ \t\f]*$" ; space-only line 10197 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10198 ;; The following is not ideal, but the Fill customization 10199 ;; options really only handle paragraph-starting prefixes, 10200 ;; not paragraph-ending suffixes: 10201 ".* $" ; line ending in two spaces 10202 "^#+" 10203 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext 10204 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def 10205 "\\|")) 10206 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") 10207 (setq-local adaptive-fill-regexp "\\s-*") 10208 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) 10209 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) 10210 ;; Outline mode 10211 (setq-local outline-regexp markdown-regex-header) 10212 (setq-local outline-level #'markdown-outline-level) 10213 ;; Cause use of ellipses for invisible text. 10214 (add-to-invisibility-spec '(outline . t)) 10215 ;; ElDoc support 10216 (if (boundp 'eldoc-documentation-functions) 10217 (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) 10218 (add-function :before-until (local 'eldoc-documentation-function) 10219 #'markdown-eldoc-function)) 10220 ;; Inhibiting line-breaking: 10221 ;; Separating out each condition into a separate function so that users can 10222 ;; override if desired (with remove-hook) 10223 (add-hook 'fill-nobreak-predicate 10224 #'markdown-line-is-reference-definition-p nil t) 10225 (add-hook 'fill-nobreak-predicate 10226 #'markdown-pipe-at-bol-p nil t) 10227 10228 ;; Indentation 10229 (setq-local indent-line-function markdown-indent-function) 10230 (setq-local indent-region-function #'markdown--indent-region) 10231 10232 ;; Flyspell 10233 (setq-local flyspell-generic-check-word-predicate 10234 #'markdown-flyspell-check-word-p) 10235 10236 ;; Electric quoting 10237 (add-hook 'electric-quote-inhibit-functions 10238 #'markdown--inhibit-electric-quote nil :local) 10239 10240 ;; drag and drop handler 10241 (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) 10242 dnd-protocol-alist)) 10243 10244 ;; media handler 10245 (when (version< "29" emacs-version) 10246 (yank-media-handler "image/.*" #'markdown--image-media-handler) 10247 ;; TODO support other than GNOME, like KDE etc 10248 (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) 10249 10250 ;; Make checkboxes buttons 10251 (when markdown-make-gfm-checkboxes-buttons 10252 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) 10253 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) 10254 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) 10255 10256 ;; edit-indirect 10257 (add-hook 'edit-indirect-after-commit-functions 10258 #'markdown--edit-indirect-after-commit-function 10259 nil 'local) 10260 10261 ;; Marginalized headings 10262 (when markdown-marginalize-headers 10263 (add-hook 'window-configuration-change-hook 10264 #'markdown-marginalize-update-current nil t)) 10265 10266 ;; add live preview export hook 10267 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) 10268 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) 10269 10270 ;; Add a custom keymap for `visual-line-mode' so that activating 10271 ;; this minor mode does not override markdown-mode's keybindings. 10272 ;; FIXME: Probably `visual-line-mode' should take care of this. 10273 (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) 10274 (newmap (make-sparse-keymap))) 10275 (set-keymap-parent newmap oldmap) 10276 (define-key newmap [remap move-beginning-of-line] nil) 10277 (define-key newmap [remap move-end-of-line] nil) 10278 (make-local-variable 'minor-mode-overriding-map-alist) 10279 (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) 10280 10281 ;;;###autoload 10282 (add-to-list 'auto-mode-alist 10283 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) 10284 10285 10286 ;;; GitHub Flavored Markdown Mode ============================================ 10287 10288 (defun gfm--electric-pair-fence-code-block () 10289 (when (and electric-pair-mode 10290 (not markdown-gfm-use-electric-backquote) 10291 (eql last-command-event ?`) 10292 (let ((count 0)) 10293 (while (eql (char-before (- (point) count)) ?`) 10294 (cl-incf count)) 10295 (= count 3)) 10296 (eql (char-after) ?`)) 10297 (save-excursion (insert (make-string 2 ?`))))) 10298 10299 (defvar gfm-mode-hook nil 10300 "Hook run when entering GFM mode.") 10301 10302 ;;;###autoload 10303 (define-derived-mode gfm-mode markdown-mode "GFM" 10304 "Major mode for editing GitHub Flavored Markdown files." 10305 (setq markdown-link-space-sub-char "-") 10306 (setq markdown-wiki-link-search-subdirectories t) 10307 (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) 10308 (setq-local paragraph-separate 10309 (concat paragraph-separate 10310 "\\|" 10311 ;; GFM alert syntax 10312 "^>\s-*\\[!\\(?:NOTE\\|TIP\\|IMPORTANT\\|WARNING\\|CAUTION\\)\\]")) 10313 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) 10314 (markdown-gfm-parse-buffer-for-languages)) 10315 10316 10317 ;;; Viewing modes ============================================================= 10318 10319 (defcustom markdown-hide-markup-in-view-modes t 10320 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." 10321 :group 'markdown 10322 :type 'boolean 10323 :safe #'booleanp) 10324 10325 (defvar markdown-view-mode-map 10326 (let ((map (make-sparse-keymap))) 10327 (define-key map (kbd "p") #'markdown-outline-previous) 10328 (define-key map (kbd "n") #'markdown-outline-next) 10329 (define-key map (kbd "f") #'markdown-outline-next-same-level) 10330 (define-key map (kbd "b") #'markdown-outline-previous-same-level) 10331 (define-key map (kbd "u") #'markdown-outline-up) 10332 (define-key map (kbd "DEL") #'scroll-down-command) 10333 (define-key map (kbd "SPC") #'scroll-up-command) 10334 (define-key map (kbd ">") #'end-of-buffer) 10335 (define-key map (kbd "<") #'beginning-of-buffer) 10336 (define-key map (kbd "q") #'kill-this-buffer) 10337 (define-key map (kbd "?") #'describe-mode) 10338 map) 10339 "Keymap for `markdown-view-mode'.") 10340 10341 (defun markdown--filter-visible (beg end &optional delete) 10342 (let ((result "") 10343 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) 10344 (while (< beg end) 10345 (when (markdown--face-p beg invisible-faces) 10346 (cl-incf beg) 10347 (while (and (markdown--face-p beg invisible-faces) (< beg end)) 10348 (cl-incf beg))) 10349 (let ((next (next-single-char-property-change beg 'invisible))) 10350 (unless (get-char-property beg 'invisible) 10351 (setq result (concat result (buffer-substring beg (min end next))))) 10352 (setq beg next))) 10353 (prog1 result 10354 (when delete 10355 (let ((inhibit-read-only t)) 10356 (delete-region beg end)))))) 10357 10358 ;;;###autoload 10359 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View" 10360 "Major mode for viewing Markdown content." 10361 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10362 (add-to-invisibility-spec 'markdown-markup) 10363 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10364 (read-only-mode 1)) 10365 10366 (defvar gfm-view-mode-map 10367 markdown-view-mode-map 10368 "Keymap for `gfm-view-mode'.") 10369 10370 ;;;###autoload 10371 (define-derived-mode gfm-view-mode gfm-mode "GFM-View" 10372 "Major mode for viewing GitHub Flavored Markdown content." 10373 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10374 (setq-local markdown-fontify-code-blocks-natively t) 10375 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10376 (add-to-invisibility-spec 'markdown-markup) 10377 (read-only-mode 1)) 10378 10379 10380 ;;; Live Preview Mode ======================================================== 10381 ;;;###autoload 10382 (define-minor-mode markdown-live-preview-mode 10383 "Toggle native previewing on save for a specific markdown file." 10384 :lighter " MD-Preview" 10385 (if markdown-live-preview-mode 10386 (if (markdown-live-preview-get-filename) 10387 (markdown-display-buffer-other-window (markdown-live-preview-export)) 10388 (markdown-live-preview-mode -1) 10389 (user-error "Buffer %s does not visit a file" (current-buffer))) 10390 (markdown-live-preview-remove))) 10391 10392 10393 (provide 'markdown-mode) 10394 10395 ;; Local Variables: 10396 ;; indent-tabs-mode: nil 10397 ;; coding: utf-8 10398 ;; End: 10399 ;;; markdown-mode.el ends here