markdown-mode.el (440298B)
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 ;; Version: 2.7-alpha 10 ;; Package-Requires: ((emacs "27.1")) 11 ;; Keywords: Markdown, GitHub Flavored Markdown, itex 12 ;; URL: https://jblevins.org/projects/markdown-mode/ 13 14 ;; This file is not part of GNU Emacs. 15 16 ;; This program is free software; you can redistribute it and/or modify 17 ;; it under the terms of the GNU General Public License as published by 18 ;; the Free Software Foundation, either version 3 of the License, or 19 ;; (at your option) any later version. 20 21 ;; This program is distributed in the hope that it will be useful, 22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 ;; GNU General Public License for more details. 25 26 ;; You should have received a copy of the GNU General Public License 27 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 28 29 ;;; Commentary: 30 31 ;; See the README.md file for details. 32 33 34 ;;; Code: 35 36 (require 'easymenu) 37 (require 'outline) 38 (require 'thingatpt) 39 (require 'cl-lib) 40 (require 'url-parse) 41 (require 'button) 42 (require 'color) 43 (require 'rx) 44 (require 'subr-x) 45 46 (defvar jit-lock-start) 47 (defvar jit-lock-end) 48 (defvar flyspell-generic-check-word-predicate) 49 (defvar electric-pair-pairs) 50 (defvar sh-ancestor-alist) 51 52 (declare-function project-roots "project") 53 (declare-function sh-set-shell "sh-script") 54 (declare-function mailcap-file-name-to-mime-type "mailcap") 55 (declare-function dnd-get-local-file-name "dnd") 56 57 ;; for older emacs<29 58 (declare-function mailcap-mime-type-to-extension "mailcap") 59 (declare-function file-name-with-extension "files") 60 (declare-function yank-media-handler "yank-media") 61 62 63 ;;; Constants ================================================================= 64 65 (defconst markdown-mode-version "2.7-alpha" 66 "Markdown mode version number.") 67 68 (defconst markdown-output-buffer-name "*markdown-output*" 69 "Name of temporary buffer for markdown command output.") 70 71 72 ;;; Global Variables ========================================================== 73 74 (defvar markdown-reference-label-history nil 75 "History of used reference labels.") 76 77 (defvar markdown-live-preview-mode nil 78 "Sentinel variable for command `markdown-live-preview-mode'.") 79 80 (defvar markdown-gfm-language-history nil 81 "History list of languages used in the current buffer in GFM code blocks.") 82 83 (defvar markdown-follow-link-functions nil 84 "Functions used to follow a link. 85 Each function is called with one argument, the link's URL. It 86 should return non-nil if it followed the link, or nil if not. 87 Functions are called in order until one of them returns non-nil; 88 otherwise the default link-following function is used.") 89 90 91 ;;; Customizable Variables ==================================================== 92 93 (defvar markdown-mode-hook nil 94 "Hook run when entering Markdown mode.") 95 96 (defvar markdown-before-export-hook nil 97 "Hook run before running Markdown to export XHTML output. 98 The hook may modify the buffer, which will be restored to it's 99 original state after exporting is complete.") 100 101 (defvar markdown-after-export-hook nil 102 "Hook run after XHTML output has been saved. 103 Any changes to the output buffer made by this hook will be saved.") 104 105 (defgroup markdown nil 106 "Major mode for editing text files in Markdown format." 107 :prefix "markdown-" 108 :group 'text 109 :link '(url-link "https://jblevins.org/projects/markdown-mode/")) 110 111 (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") 112 when (executable-find cmd) 113 return (file-name-nondirectory it)))) 114 (or command "markdown")) 115 "Command to run markdown." 116 :group 'markdown 117 :type '(choice (string :tag "Shell command") (repeat (string)) function)) 118 119 (defcustom markdown-command-needs-filename nil 120 "Set to non-nil if `markdown-command' does not accept input from stdin. 121 Instead, it will be passed a filename as the final command line 122 option. As a result, you will only be able to run Markdown from 123 buffers which are visiting a file." 124 :group 'markdown 125 :type 'boolean) 126 127 (defcustom markdown-open-command nil 128 "Command used for opening Markdown files directly. 129 For example, a standalone Markdown previewer. This command will 130 be called with a single argument: the filename of the current 131 buffer. It can also be a function, which will be called without 132 arguments." 133 :group 'markdown 134 :type '(choice file function (const :tag "None" nil))) 135 136 (defcustom markdown-open-image-command nil 137 "Command used for opening image files directly. 138 This is used at `markdown-follow-link-at-point'." 139 :group 'markdown 140 :type '(choice file function (const :tag "None" nil))) 141 142 (defcustom markdown-hr-strings 143 '("-------------------------------------------------------------------------------" 144 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" 145 "---------------------------------------" 146 "* * * * * * * * * * * * * * * * * * * *" 147 "---------" 148 "* * * * *") 149 "Strings to use when inserting horizontal rules. 150 The first string in the list will be the default when inserting a 151 horizontal rule. Strings should be listed in decreasing order of 152 prominence (as in headings from level one to six) for use with 153 promotion and demotion functions." 154 :group 'markdown 155 :type '(repeat string)) 156 157 (defcustom markdown-bold-underscore nil 158 "Use two underscores when inserting bold text instead of two asterisks." 159 :group 'markdown 160 :type 'boolean) 161 162 (defcustom markdown-italic-underscore nil 163 "Use underscores when inserting italic text instead of asterisks." 164 :group 'markdown 165 :type 'boolean) 166 167 (defcustom markdown-marginalize-headers nil 168 "When non-nil, put opening atx header markup in a left margin. 169 170 This setting goes well with `markdown-asymmetric-header'. But 171 sadly it conflicts with `linum-mode' since they both use the 172 same margin." 173 :group 'markdown 174 :type 'boolean 175 :safe 'booleanp 176 :package-version '(markdown-mode . "2.4")) 177 178 (defcustom markdown-marginalize-headers-margin-width 6 179 "Character width of margin used for marginalized headers. 180 The default value is based on there being six heading levels 181 defined by Markdown and HTML. Increasing this produces extra 182 whitespace on the left. Decreasing it may be preferred when 183 fewer than six nested heading levels are used." 184 :group 'markdown 185 :type 'integer 186 :safe 'natnump 187 :package-version '(markdown-mode . "2.4")) 188 189 (defcustom markdown-asymmetric-header nil 190 "Determines if atx header style will be asymmetric. 191 Set to a non-nil value to use asymmetric header styling, placing 192 header markup only at the beginning of the line. By default, 193 balanced markup will be inserted at the beginning and end of the 194 line around the header title." 195 :group 'markdown 196 :type 'boolean) 197 198 (defcustom markdown-indent-function 'markdown-indent-line 199 "Function to use to indent." 200 :group 'markdown 201 :type 'function) 202 203 (defcustom markdown-indent-on-enter t 204 "Determines indentation behavior when pressing \\[newline]. 205 Possible settings are nil, t, and \\='indent-and-new-item. 206 207 When non-nil, pressing \\[newline] will call `newline-and-indent' 208 to indent the following line according to the context using 209 `markdown-indent-function'. In this case, note that 210 \\[electric-newline-and-maybe-indent] can still be used to insert 211 a newline without indentation. 212 213 When set to \\='indent-and-new-item and the point is in a list item 214 when \\[newline] is pressed, the list will be continued on the next 215 line, where a new item will be inserted. 216 217 When set to nil, simply call `newline' as usual. In this case, 218 you can still indent lines using \\[markdown-cycle] and continue 219 lists with \\[markdown-insert-list-item]. 220 221 Note that this assumes the variable `electric-indent-mode' is 222 non-nil (enabled). When it is *disabled*, the behavior of 223 \\[newline] and `\\[electric-newline-and-maybe-indent]' are 224 reversed." 225 :group 'markdown 226 :type '(choice (const :tag "Don't automatically indent" nil) 227 (const :tag "Automatically indent" t) 228 (const :tag "Automatically indent and insert new list items" indent-and-new-item))) 229 230 (defcustom markdown-enable-wiki-links nil 231 "Syntax highlighting for wiki links. 232 Set this to a non-nil value to turn on wiki link support by default. 233 Support can be toggled later using the `markdown-toggle-wiki-links' 234 function or \\[markdown-toggle-wiki-links]." 235 :group 'markdown 236 :type 'boolean 237 :safe 'booleanp 238 :package-version '(markdown-mode . "2.2")) 239 240 (defcustom markdown-wiki-link-alias-first t 241 "When non-nil, treat aliased wiki links like [[alias text|PageName]]. 242 Otherwise, they will be treated as [[PageName|alias text]]." 243 :group 'markdown 244 :type 'boolean 245 :safe 'booleanp) 246 247 (defcustom markdown-wiki-link-search-subdirectories nil 248 "When non-nil, search for wiki link targets in subdirectories. 249 This is the default search behavior for GitHub and is 250 automatically set to t in `gfm-mode'." 251 :group 'markdown 252 :type 'boolean 253 :safe 'booleanp 254 :package-version '(markdown-mode . "2.2")) 255 256 (defcustom markdown-wiki-link-search-parent-directories nil 257 "When non-nil, search for wiki link targets in parent directories. 258 This is the default search behavior of Ikiwiki." 259 :group 'markdown 260 :type 'boolean 261 :safe 'booleanp 262 :package-version '(markdown-mode . "2.2")) 263 264 (defcustom markdown-wiki-link-search-type nil 265 "Searching type for markdown wiki link. 266 267 sub-directories: search for wiki link targets in sub directories 268 parent-directories: search for wiki link targets in parent directories 269 project: search for wiki link targets under project root" 270 :group 'markdown 271 :type '(set 272 (const :tag "search wiki link from subdirectories" sub-directories) 273 (const :tag "search wiki link from parent directories" parent-directories) 274 (const :tag "search wiki link under project root" project)) 275 :package-version '(markdown-mode . "2.5")) 276 277 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") 278 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") 279 280 (defcustom markdown-wiki-link-fontify-missing nil 281 "When non-nil, change wiki link face according to existence of target files. 282 This is expensive because it requires checking for the file each time the buffer 283 changes or the user switches windows. It is disabled by default because it may 284 cause lag when typing on slower machines." 285 :group 'markdown 286 :type 'boolean 287 :safe 'booleanp 288 :package-version '(markdown-mode . "2.2")) 289 290 (defcustom markdown-uri-types 291 '("acap" "cid" "data" "dav" "fax" "file" "ftp" 292 "geo" "gopher" "http" "https" "imap" "ldap" "mailto" 293 "mid" "message" "modem" "news" "nfs" "nntp" 294 "pop" "prospero" "rtsp" "service" "sip" "tel" 295 "telnet" "tip" "urn" "vemmi" "wais") 296 "Link types for syntax highlighting of URIs." 297 :group 'markdown 298 :type '(repeat (string :tag "URI scheme"))) 299 300 (defcustom markdown-url-compose-char 301 '(?∞ ?… ?⋯ ?# ?★ ?⚓) 302 "Placeholder character for hidden URLs. 303 This may be a single character or a list of characters. In case 304 of a list, the first one that satisfies `char-displayable-p' will 305 be used." 306 :type '(choice 307 (character :tag "Single URL replacement character") 308 (repeat :tag "List of possible URL replacement characters" 309 character)) 310 :package-version '(markdown-mode . "2.3")) 311 312 (defcustom markdown-blockquote-display-char 313 '("▌" "┃" ">") 314 "String to display when hiding blockquote markup. 315 This may be a single string or a list of string. In case of a 316 list, the first one that satisfies `char-displayable-p' will be 317 used." 318 :type '(choice 319 (string :tag "Single blockquote display string") 320 (repeat :tag "List of possible blockquote display strings" string)) 321 :package-version '(markdown-mode . "2.3")) 322 323 (defcustom markdown-hr-display-char 324 '(?─ ?━ ?-) 325 "Character for hiding horizontal rule markup. 326 This may be a single character or a list of characters. In case 327 of a list, the first one that satisfies `char-displayable-p' will 328 be used." 329 :group 'markdown 330 :type '(choice 331 (character :tag "Single HR display character") 332 (repeat :tag "List of possible HR display characters" character)) 333 :package-version '(markdown-mode . "2.3")) 334 335 (defcustom markdown-definition-display-char 336 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) 337 "Character for replacing definition list markup. 338 This may be a single character or a list of characters. In case 339 of a list, the first one that satisfies `char-displayable-p' will 340 be used." 341 :type '(choice 342 (character :tag "Single definition list character") 343 (repeat :tag "List of possible definition list characters" character)) 344 :package-version '(markdown-mode . "2.3")) 345 346 (defcustom markdown-enable-math nil 347 "Syntax highlighting for inline LaTeX and itex expressions. 348 Set this to a non-nil value to turn on math support by default. 349 Math support can be enabled, disabled, or toggled later using 350 `markdown-toggle-math' or \\[markdown-toggle-math]." 351 :group 'markdown 352 :type 'boolean 353 :safe 'booleanp) 354 (make-variable-buffer-local 'markdown-enable-math) 355 356 (defcustom markdown-enable-html t 357 "Enable font-lock support for HTML tags and attributes." 358 :group 'markdown 359 :type 'boolean 360 :safe 'booleanp 361 :package-version '(markdown-mode . "2.4")) 362 363 (defcustom markdown-enable-highlighting-syntax nil 364 "Enable highlighting syntax." 365 :group 'markdown 366 :type 'boolean 367 :safe 'booleanp 368 :package-version '(markdown-mode . "2.5")) 369 370 (defcustom markdown-css-paths nil 371 "List of URLs of CSS files to link to in the output XHTML." 372 :group 'markdown 373 :type '(repeat (string :tag "CSS File Path"))) 374 375 (defcustom markdown-content-type "text/html" 376 "Content type string for the http-equiv header in XHTML output. 377 When set to an empty string, this attribute is omitted. Defaults to 378 `text/html'." 379 :group 'markdown 380 :type 'string) 381 382 (defcustom markdown-coding-system nil 383 "Character set string for the http-equiv header in XHTML output. 384 Defaults to `buffer-file-coding-system' (and falling back to 385 `utf-8' when not available). Common settings are `iso-8859-1' 386 and `iso-latin-1'. Use `list-coding-systems' for more choices." 387 :group 'markdown 388 :type 'coding-system) 389 390 (defcustom markdown-export-kill-buffer t 391 "Kill output buffer after HTML export. 392 When non-nil, kill the HTML output buffer after 393 exporting with `markdown-export'." 394 :group 'markdown 395 :type 'boolean 396 :safe 'booleanp 397 :package-version '(markdown-mode . "2.4")) 398 399 (defcustom markdown-xhtml-header-content "" 400 "Additional content to include in the XHTML <head> block." 401 :group 'markdown 402 :type 'string) 403 404 (defcustom markdown-xhtml-body-preamble "" 405 "Content to include in the XHTML <body> block, before the output." 406 :group 'markdown 407 :type 'string 408 :safe 'stringp 409 :package-version '(markdown-mode . "2.4")) 410 411 (defcustom markdown-xhtml-body-epilogue "" 412 "Content to include in the XHTML <body> block, after the output." 413 :group 'markdown 414 :type 'string 415 :safe 'stringp 416 :package-version '(markdown-mode . "2.4")) 417 418 (defcustom markdown-xhtml-standalone-regexp 419 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" 420 "Regexp indicating whether `markdown-command' output is standalone XHTML." 421 :group 'markdown 422 :type 'regexp) 423 424 (defcustom markdown-link-space-sub-char "_" 425 "Character to use instead of spaces when mapping wiki links to filenames." 426 :group 'markdown 427 :type 'string) 428 429 (defcustom markdown-reference-location 'header 430 "Position where new reference definitions are inserted in the document." 431 :group 'markdown 432 :type '(choice (const :tag "At the end of the document" end) 433 (const :tag "Immediately after the current block" immediately) 434 (const :tag "At the end of the subtree" subtree) 435 (const :tag "Before next header" header))) 436 437 (defcustom markdown-footnote-location 'end 438 "Position where new footnotes are inserted in the document." 439 :group 'markdown 440 :type '(choice (const :tag "At the end of the document" end) 441 (const :tag "Immediately after the current block" immediately) 442 (const :tag "At the end of the subtree" subtree) 443 (const :tag "Before next header" header))) 444 445 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) 446 "Display specification for footnote markers and inline footnotes. 447 By default, footnote text is reduced in size and raised. Set to 448 nil to disable this." 449 :group 'markdown 450 :type '(choice (sexp :tag "Display specification") 451 (const :tag "Don't set display property" nil)) 452 :package-version '(markdown-mode . "2.4")) 453 454 (defcustom markdown-sub-superscript-display 455 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) 456 "Display specification for subscript and superscripts. 457 The car is used for subscript, the cdr is used for superscripts." 458 :group 'markdown 459 :type '(cons (choice (sexp :tag "Subscript form") 460 (const :tag "No lowering" nil)) 461 (choice (sexp :tag "Superscript form") 462 (const :tag "No raising" nil))) 463 :package-version '(markdown-mode . "2.4")) 464 465 (defcustom markdown-unordered-list-item-prefix " * " 466 "String inserted before unordered list items." 467 :group 'markdown 468 :type 'string) 469 470 (defcustom markdown-ordered-list-enumeration t 471 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. 472 While nil, always uses '1.' for the marker" 473 :group 'markdown 474 :type 'boolean 475 :package-version '(markdown-mode . "2.5")) 476 477 (defcustom markdown-nested-imenu-heading-index t 478 "Use nested or flat imenu heading index. 479 A nested index may provide more natural browsing from the menu, 480 but a flat list may allow for faster keyboard navigation via tab 481 completion." 482 :group 'markdown 483 :type 'boolean 484 :safe 'booleanp 485 :package-version '(markdown-mode . "2.2")) 486 487 (defcustom markdown-add-footnotes-to-imenu t 488 "Add footnotes to end of imenu heading index." 489 :group 'markdown 490 :type 'boolean 491 :safe 'booleanp 492 :package-version '(markdown-mode . "2.4")) 493 494 (defcustom markdown-make-gfm-checkboxes-buttons t 495 "When non-nil, make GFM checkboxes into buttons." 496 :group 'markdown 497 :type 'boolean) 498 499 (defcustom markdown-use-pandoc-style-yaml-metadata nil 500 "When non-nil, allow YAML metadata anywhere in the document." 501 :group 'markdown 502 :type 'boolean) 503 504 (defcustom markdown-split-window-direction 'any 505 "Preference for splitting windows for static and live preview. 506 The default value is \\='any, which instructs Emacs to use 507 `split-window-sensibly' to automatically choose how to split 508 windows based on the values of `split-width-threshold' and 509 `split-height-threshold' and the available windows. To force 510 vertically split (left and right) windows, set this to \\='vertical 511 or \\='right. To force horizontally split (top and bottom) windows, 512 set this to \\='horizontal or \\='below. 513 514 If this value is \\='any and `display-buffer-alist' is set then 515 `display-buffer' is used for open buffer function" 516 :group 'markdown 517 :type '(choice (const :tag "Automatic" any) 518 (const :tag "Right (vertical)" right) 519 (const :tag "Below (horizontal)" below)) 520 :package-version '(markdown-mode . "2.2")) 521 522 (defcustom markdown-live-preview-window-function 523 #'markdown-live-preview-window-eww 524 "Function to display preview of Markdown output within Emacs. 525 Function must update the buffer containing the preview and return 526 the buffer." 527 :group 'markdown 528 :type 'function) 529 530 (defcustom markdown-live-preview-delete-export 'delete-on-destroy 531 "Delete exported HTML file when using `markdown-live-preview-export'. 532 If set to \\='delete-on-export, delete on every export. When set to 533 \\='delete-on-destroy delete when quitting from command 534 `markdown-live-preview-mode'. Never delete if set to nil." 535 :group 'markdown 536 :type '(choice 537 (const :tag "Delete on every export" delete-on-export) 538 (const :tag "Delete when quitting live preview" delete-on-destroy) 539 (const :tag "Never delete" nil))) 540 541 (defcustom markdown-list-indent-width 4 542 "Depth of indentation for markdown lists. 543 Used in `markdown-demote-list-item' and 544 `markdown-promote-list-item'." 545 :group 'markdown 546 :type 'integer) 547 548 (defcustom markdown-enable-prefix-prompts t 549 "Display prompts for certain prefix commands. 550 Set to nil to disable these prompts." 551 :group 'markdown 552 :type 'boolean 553 :safe 'booleanp 554 :package-version '(markdown-mode . "2.3")) 555 556 (defcustom markdown-gfm-additional-languages nil 557 "Extra languages made available when inserting GFM code blocks. 558 Language strings must have be trimmed of whitespace and not 559 contain any curly braces. They may be of arbitrary 560 capitalization, though." 561 :group 'markdown 562 :type '(repeat (string :validate markdown-validate-language-string))) 563 564 (defcustom markdown-gfm-use-electric-backquote t 565 "Use `markdown-electric-backquote' when backquote is hit three times." 566 :group 'markdown 567 :type 'boolean) 568 569 (defcustom markdown-gfm-downcase-languages t 570 "If non-nil, downcase suggested languages. 571 This applies to insertions done with 572 `markdown-electric-backquote'." 573 :group 'markdown 574 :type 'boolean) 575 576 (defcustom markdown-edit-code-block-default-mode 'normal-mode 577 "Default mode to use for editing code blocks. 578 This mode is used when automatic detection fails, such as for GFM 579 code blocks with no language specified." 580 :group 'markdown 581 :type '(choice function (const :tag "None" nil)) 582 :package-version '(markdown-mode . "2.4")) 583 584 (defcustom markdown-gfm-uppercase-checkbox nil 585 "If non-nil, use [X] for completed checkboxes, [x] otherwise." 586 :group 'markdown 587 :type 'boolean 588 :safe 'booleanp) 589 590 (defcustom markdown-hide-urls nil 591 "Hide URLs of inline links and reference tags of reference links. 592 Such URLs will be replaced by a single customizable 593 character, defined by `markdown-url-compose-char', but are still part 594 of the buffer. Links can be edited interactively with 595 \\[markdown-insert-link] or, for example, by deleting the final 596 parenthesis to remove the invisibility property. You can also 597 hover your mouse pointer over the link text to see the URL. 598 Set this to a non-nil value to turn this feature on by default. 599 You can interactively set the value of this variable by calling 600 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], 601 or from the menu Markdown > Links & Images menu." 602 :group 'markdown 603 :type 'boolean 604 :safe 'booleanp 605 :package-version '(markdown-mode . "2.3")) 606 (make-variable-buffer-local 'markdown-hide-urls) 607 608 (defcustom markdown-translate-filename-function #'identity 609 "Function to use to translate filenames when following links. 610 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] 611 call this function with the filename as only argument whenever 612 they encounter a filename (instead of a URL) to be visited and 613 use its return value instead of the filename in the link. For 614 example, if absolute filenames are actually relative to a server 615 root directory, you can set 616 `markdown-translate-filename-function' to a function that 617 prepends the root directory to the given filename." 618 :group 'markdown 619 :type 'function 620 :risky t 621 :package-version '(markdown-mode . "2.4")) 622 623 (defcustom markdown-max-image-size nil 624 "Maximum width and height for displayed inline images. 625 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). 626 When nil, use the actual size. Otherwise, use ImageMagick to 627 resize larger images to be of the given maximum dimensions. This 628 requires Emacs to be built with ImageMagick support." 629 :group 'markdown 630 :package-version '(markdown-mode . "2.4") 631 :type '(choice 632 (const :tag "Use actual image width" nil) 633 (cons (choice (sexp :tag "Maximum width in pixels") 634 (const :tag "No maximum width" nil)) 635 (choice (sexp :tag "Maximum height in pixels") 636 (const :tag "No maximum height" nil))))) 637 638 (defcustom markdown-mouse-follow-link t 639 "Non-nil means mouse on a link will follow the link. 640 This variable must be set before loading markdown-mode." 641 :group 'markdown 642 :type 'boolean 643 :safe 'booleanp 644 :package-version '(markdown-mode . "2.5")) 645 646 (defcustom markdown-table-align-p t 647 "Non-nil means that table is aligned after table operation." 648 :group 'markdown 649 :type 'boolean 650 :safe 'booleanp 651 :package-version '(markdown-mode . "2.5")) 652 653 (defcustom markdown-fontify-whole-heading-line nil 654 "Non-nil means fontify the whole line for headings. 655 This is useful when setting a background color for the 656 markdown-header-face-* faces." 657 :group 'markdown 658 :type 'boolean 659 :safe 'booleanp 660 :package-version '(markdown-mode . "2.5")) 661 662 (defcustom markdown-special-ctrl-a/e nil 663 "Non-nil means `C-a' and `C-e' behave specially in headlines and items. 664 665 When t, `C-a' will bring back the cursor to the beginning of the 666 headline text. In an item, this will be the position after bullet 667 and check-box, if any. When the cursor is already at that 668 position, another `C-a' will bring it to the beginning of the 669 line. 670 671 `C-e' will jump to the end of the headline, ignoring the presence 672 of closing tags in the headline. A second `C-e' will then jump to 673 the true end of the line, after closing tags. This also means 674 that, when this variable is non-nil, `C-e' also will never jump 675 beyond the end of the heading of a folded section, i.e. not after 676 the ellipses. 677 678 When set to the symbol `reversed', the first `C-a' or `C-e' works 679 normally, going to the true line boundary first. Only a directly 680 following, identical keypress will bring the cursor to the 681 special positions. 682 683 This may also be a cons cell where the behavior for `C-a' and 684 `C-e' is set separately." 685 :group 'markdown 686 :type '(choice 687 (const :tag "off" nil) 688 (const :tag "on: after hashes/bullet and before closing tags first" t) 689 (const :tag "reversed: true line boundary first" reversed) 690 (cons :tag "Set C-a and C-e separately" 691 (choice :tag "Special C-a" 692 (const :tag "off" nil) 693 (const :tag "on: after hashes/bullet first" t) 694 (const :tag "reversed: before hashes/bullet first" reversed)) 695 (choice :tag "Special C-e" 696 (const :tag "off" nil) 697 (const :tag "on: before closing tags first" t) 698 (const :tag "reversed: after closing tags first" reversed)))) 699 :package-version '(markdown-mode . "2.7")) 700 701 ;;; Markdown-Specific `rx' Macro ============================================== 702 703 ;; Based on python-rx from python.el. 704 (eval-and-compile 705 (defconst markdown-rx-constituents 706 `((newline . ,(rx "\n")) 707 ;; Note: #405 not consider markdown-list-indent-width however this is never used 708 (indent . ,(rx (or (repeat 4 " ") "\t"))) 709 (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end)))) 710 (numeral . ,(rx (and (one-or-more (any "0-9#")) "."))) 711 (bullet . ,(rx (any "*+:-"))) 712 (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".") 713 (any "*+:-")))) 714 (checkbox . ,(rx "[" (any " xX") "]"))) 715 "Markdown-specific sexps for `markdown-rx'") 716 717 (defun markdown-rx-to-string (form &optional no-group) 718 "Markdown mode specialized `rx-to-string' function. 719 This variant supports named Markdown expressions in FORM. 720 NO-GROUP non-nil means don't put shy groups around the result." 721 (let ((rx-constituents (append markdown-rx-constituents rx-constituents))) 722 (rx-to-string form no-group))) 723 724 (defmacro markdown-rx (&rest regexps) 725 "Markdown mode specialized rx macro. 726 This variant of `rx' supports common Markdown named REGEXPS." 727 (cond ((null regexps) 728 (error "No regexp")) 729 ((cdr regexps) 730 (markdown-rx-to-string `(and ,@regexps) t)) 731 (t 732 (markdown-rx-to-string (car regexps) t))))) 733 734 735 ;;; Regular Expressions ======================================================= 736 737 (defconst markdown-regex-comment-start 738 "<!--" 739 "Regular expression matches HTML comment opening.") 740 741 (defconst markdown-regex-comment-end 742 "--[ \t]*>" 743 "Regular expression matches HTML comment closing.") 744 745 (defconst markdown-regex-link-inline 746 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" 747 "Regular expression for a [text](file) or an image link . 748 Group 1 matches the leading exclamation point (optional). 749 Group 2 matches the opening square bracket. 750 Group 3 matches the text inside the square brackets. 751 Group 4 matches the closing square bracket. 752 Group 5 matches the opening parenthesis. 753 Group 6 matches the URL. 754 Group 7 matches the title (optional). 755 Group 8 matches the closing parenthesis.") 756 757 (defconst markdown-regex-link-reference 758 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" 759 "Regular expression for a reference link [text][id]. 760 Group 1 matches the leading exclamation point (optional). 761 Group 2 matches the opening square bracket for the link text. 762 Group 3 matches the text inside the square brackets. 763 Group 4 matches the closing square bracket for the link text. 764 Group 5 matches the opening square bracket for the reference label. 765 Group 6 matches the reference label. 766 Group 7 matches the closing square bracket for the reference label.") 767 768 (defconst markdown-regex-reference-definition 769 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" 770 "Regular expression for a reference definition. 771 Group 1 matches the opening square bracket. 772 Group 2 matches the reference label. 773 Group 3 matches the closing square bracket. 774 Group 4 matches the colon. 775 Group 5 matches the URL. 776 Group 6 matches the title attribute (optional).") 777 778 (defconst markdown-regex-footnote 779 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" 780 "Regular expression for a footnote marker [^fn]. 781 Group 1 matches the opening square bracket and carat. 782 Group 2 matches only the label, without the surrounding markup. 783 Group 3 matches the closing square bracket.") 784 785 (defconst markdown-regex-header 786 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" 787 "Regexp identifying Markdown headings. 788 Group 1 matches the text of a setext heading. 789 Group 2 matches the underline of a level-1 setext heading. 790 Group 3 matches the underline of a level-2 setext heading. 791 Group 4 matches the opening hash marks of an atx heading and whitespace. 792 Group 5 matches the text, without surrounding whitespace, of an atx heading. 793 Group 6 matches the closing whitespace and hash marks of an atx heading.") 794 795 (defconst markdown-regex-header-setext 796 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" 797 "Regular expression for generic setext-style (underline) headers.") 798 799 (defconst markdown-regex-header-atx 800 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" 801 "Regular expression for generic atx-style (hash mark) headers.") 802 803 (defconst markdown-regex-hr 804 (rx line-start 805 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) 806 (and (repeat 3 (and "-" (? " "))) (* (any "- "))) 807 (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) 808 line-end) 809 "Regular expression for matching Markdown horizontal rules.") 810 811 (defconst markdown-regex-code 812 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" 813 "Regular expression for matching inline code fragments. 814 815 Group 1 matches the entire code fragment including the backquotes. 816 Group 2 matches the opening backquotes. 817 Group 3 matches the code fragment itself, without backquotes. 818 Group 4 matches the closing backquotes. 819 820 The leading, unnumbered group ensures that the leading backquote 821 character is not escaped. 822 The last group, also unnumbered, requires that the character 823 following the code fragment is not a backquote. 824 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, 825 but not two newlines in a row.") 826 827 (defconst markdown-regex-kbd 828 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" 829 "Regular expression for matching <kbd> tags. 830 Groups 1 and 3 match the opening and closing tags. 831 Group 2 matches the key sequence.") 832 833 (defconst markdown-regex-gfm-code-block-open 834 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" 835 "Regular expression matching opening of GFM code blocks. 836 Group 1 matches the opening three backquotes and any following whitespace. 837 Group 2 matches the opening brace (optional) and surrounding whitespace. 838 Group 3 matches the language identifier (optional). 839 Group 4 matches the info string (optional). 840 Group 5 matches the closing brace (optional), whitespace, and newline. 841 Groups need to agree with `markdown-regex-tilde-fence-begin'.") 842 843 (defconst markdown-regex-gfm-code-block-close 844 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" 845 "Regular expression matching closing of GFM code blocks. 846 Group 1 matches the closing three backquotes. 847 Group 2 matches any whitespace and the final newline.") 848 849 (defconst markdown-regex-pre 850 "^\\( \\|\t\\).*$" 851 "Regular expression for matching preformatted text sections.") 852 853 (defconst markdown-regex-list 854 (markdown-rx line-start 855 ;; 1. Leading whitespace 856 (group (* blank)) 857 ;; 2. List marker: a numeral, bullet, or colon 858 (group list-marker) 859 ;; 3. Trailing whitespace 860 (group (+ blank)) 861 ;; 4. Optional checkbox for GFM task list items 862 (opt (group (and checkbox (* blank))))) 863 "Regular expression for matching list items.") 864 865 (defconst markdown-regex-bold 866 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" 867 "Regular expression for matching bold text. 868 Group 1 matches the character before the opening asterisk or 869 underscore, if any, ensuring that it is not a backslash escape. 870 Group 2 matches the entire expression, including delimiters. 871 Groups 3 and 5 matches the opening and closing delimiters. 872 Group 4 matches the text inside the delimiters.") 873 874 (defconst markdown-regex-italic 875 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" 876 "Regular expression for matching italic text. 877 The leading unnumbered matches the character before the opening 878 asterisk or underscore, if any, ensuring that it is not a 879 backslash escape. 880 Group 1 matches the entire expression, including delimiters. 881 Groups 2 and 4 matches the opening and closing delimiters. 882 Group 3 matches the text inside the delimiters.") 883 884 (defconst markdown-regex-strike-through 885 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" 886 "Regular expression for matching strike-through text. 887 Group 1 matches the character before the opening tilde, if any, 888 ensuring that it is not a backslash escape. 889 Group 2 matches the entire expression, including delimiters. 890 Groups 3 and 5 matches the opening and closing delimiters. 891 Group 4 matches the text inside the delimiters.") 892 893 (defconst markdown-regex-gfm-italic 894 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" 895 "Regular expression for matching italic text in GitHub Flavored Markdown. 896 Underscores in words are not treated as special. 897 Group 1 matches the entire expression, including delimiters. 898 Groups 2 and 4 matches the opening and closing delimiters. 899 Group 3 matches the text inside the delimiters.") 900 901 (defconst markdown-regex-blockquote 902 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" 903 "Regular expression for matching blockquote lines. 904 Also accounts for a potential capital letter preceding the angle 905 bracket, for use with Leanpub blocks (asides, warnings, info 906 blocks, etc.). 907 Group 1 matches the leading angle bracket. 908 Group 2 matches the separating whitespace. 909 Group 3 matches the text.") 910 911 (defconst markdown-regex-line-break 912 "[^ \n\t][ \t]*\\( \\)\n" 913 "Regular expression for matching line breaks.") 914 915 (defconst markdown-regex-escape 916 "\\(\\\\\\)." 917 "Regular expression for matching escape sequences.") 918 919 (defconst markdown-regex-wiki-link 920 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" 921 "Regular expression for matching wiki links. 922 This matches typical bracketed [[WikiLinks]] as well as \\='aliased 923 wiki links of the form [[PageName|link text]]. 924 The meanings of the first and second components depend 925 on the value of `markdown-wiki-link-alias-first'. 926 927 Group 1 matches the entire link. 928 Group 2 matches the opening square brackets. 929 Group 3 matches the first component of the wiki link. 930 Group 4 matches the pipe separator, when present. 931 Group 5 matches the second component of the wiki link, when present. 932 Group 6 matches the closing square brackets.") 933 934 (defconst markdown-regex-uri 935 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") 936 "Regular expression for matching inline URIs.") 937 938 ;; CommanMark specification says scheme length is 2-32 characters 939 (defconst markdown-regex-angle-uri 940 (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") 941 "Regular expression for matching inline URIs in angle brackets.") 942 943 (defconst markdown-regex-email 944 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" 945 "Regular expression for matching inline email addresses.") 946 947 (defsubst markdown-make-regex-link-generic () 948 "Make regular expression for matching any recognized link." 949 (concat "\\(?:" markdown-regex-link-inline 950 (when markdown-enable-wiki-links 951 (concat "\\|" markdown-regex-wiki-link)) 952 "\\|" markdown-regex-link-reference 953 "\\|" markdown-regex-angle-uri "\\)")) 954 955 (defconst markdown-regex-gfm-checkbox 956 " \\(\\[[ xX]\\]\\) " 957 "Regular expression for matching GFM checkboxes. 958 Group 1 matches the text to become a button.") 959 960 (defconst markdown-regex-blank-line 961 "^[[:blank:]]*$" 962 "Regular expression that matches a blank line.") 963 964 (defconst markdown-regex-block-separator 965 "\n[\n\t\f ]*\n" 966 "Regular expression for matching block boundaries.") 967 968 (defconst markdown-regex-block-separator-noindent 969 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") 970 "Regexp for block separators before lines with no indentation.") 971 972 (defconst markdown-regex-math-inline-single 973 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" 974 "Regular expression for itex $..$ math mode expressions. 975 Groups 1 and 3 match the opening and closing dollar signs. 976 Group 2 matches the mathematical expression contained within.") 977 978 (defconst markdown-regex-math-inline-double 979 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" 980 "Regular expression for itex $$..$$ math mode expressions. 981 Groups 1 and 3 match opening and closing dollar signs. 982 Group 2 matches the mathematical expression contained within.") 983 984 (defconst markdown-regex-math-display 985 (rx line-start (* blank) 986 (group (group (repeat 1 2 "\\")) "[") 987 (group (*? anything)) 988 (group (backref 2) "]") 989 line-end) 990 "Regular expression for \[..\] or \\[..\\] display math. 991 Groups 1 and 4 match the opening and closing markup. 992 Group 3 matches the mathematical expression contained within. 993 Group 2 matches the opening slashes, and is used internally to 994 match the closing slashes.") 995 996 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) 997 "Return regexp matching a tilde code fence at least NUM-TILDES long. 998 END-OF-LINE is the regexp construct to indicate end of line; $ if 999 missing." 1000 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" 1001 (or end-of-line "$"))) 1002 1003 (defconst markdown-regex-tilde-fence-begin 1004 (markdown-make-tilde-fence-regex 1005 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") 1006 "Regular expression for matching tilde-fenced code blocks. 1007 Group 1 matches the opening tildes. 1008 Group 2 matches (optional) opening brace and surrounding whitespace. 1009 Group 3 matches the language identifier (optional). 1010 Group 4 matches the info string (optional). 1011 Group 5 matches the closing brace (optional) and any surrounding whitespace. 1012 Groups need to agree with `markdown-regex-gfm-code-block-open'.") 1013 1014 (defconst markdown-regex-declarative-metadata 1015 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" 1016 "Regular expression for matching declarative metadata statements. 1017 This matches MultiMarkdown metadata as well as YAML and TOML 1018 assignments such as the following: 1019 1020 variable: value 1021 1022 or 1023 1024 variable = value") 1025 1026 (defconst markdown-regex-pandoc-metadata 1027 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" 1028 "Regular expression for matching Pandoc metadata.") 1029 1030 (defconst markdown-regex-yaml-metadata-border 1031 "\\(-\\{3\\}\\)$" 1032 "Regular expression for matching YAML metadata.") 1033 1034 (defconst markdown-regex-yaml-pandoc-metadata-end-border 1035 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" 1036 "Regular expression for matching YAML metadata end borders.") 1037 1038 (defsubst markdown-get-yaml-metadata-start-border () 1039 "Return YAML metadata start border depending upon whether Pandoc is used." 1040 (concat 1041 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") 1042 markdown-regex-yaml-metadata-border)) 1043 1044 (defsubst markdown-get-yaml-metadata-end-border (_) 1045 "Return YAML metadata end border depending upon whether Pandoc is used." 1046 (if markdown-use-pandoc-style-yaml-metadata 1047 markdown-regex-yaml-pandoc-metadata-end-border 1048 markdown-regex-yaml-metadata-border)) 1049 1050 (defconst markdown-regex-inline-attributes 1051 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" 1052 "Regular expression for matching inline identifiers or attribute lists. 1053 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") 1054 1055 (defconst markdown-regex-leanpub-sections 1056 (concat 1057 "^\\({\\)\\(" 1058 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) 1059 "\\)\\(}\\)[ \t]*\n") 1060 "Regular expression for Leanpub section markers and related syntax.") 1061 1062 (defconst markdown-regex-sub-superscript 1063 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" 1064 "The regular expression matching a sub- or superscript. 1065 The leading un-numbered group matches the character before the 1066 opening tilde or carat, if any, ensuring that it is not a 1067 backslash escape, carat, or tilde. 1068 Group 1 matches the entire expression, including markup. 1069 Group 2 matches the opening markup--a tilde or carat. 1070 Group 3 matches the text inside the delimiters. 1071 Group 4 matches the closing markup--a tilde or carat.") 1072 1073 (defconst markdown-regex-include 1074 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" 1075 "Regular expression matching common forms of include syntax. 1076 Marked 2, Leanpub, and other processors support some of these forms: 1077 1078 <<[sections/section1.md] 1079 <<(folder/filename) 1080 <<[Code title](folder/filename) 1081 <<{folder/raw_file.html} 1082 1083 Group 1 matches the opening two angle brackets. 1084 Groups 2-4 match the opening square bracket, the text inside, 1085 and the closing square bracket, respectively. 1086 Groups 5-7 match the opening parenthesis, the text inside, and 1087 the closing parenthesis. 1088 Groups 8-10 match the opening brace, the text inside, and the brace.") 1089 1090 (defconst markdown-regex-pandoc-inline-footnote 1091 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" 1092 "Regular expression for Pandoc inline footnote^[footnote text]. 1093 Group 1 matches the opening caret. 1094 Group 2 matches the opening square bracket. 1095 Group 3 matches the footnote text, without the surrounding markup. 1096 Group 4 matches the closing square bracket.") 1097 1098 (defconst markdown-regex-html-attr 1099 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" 1100 "Regular expression for matching HTML attributes and values. 1101 Group 1 matches the attribute name. 1102 Group 2 matches the following whitespace, equals sign, and value, if any. 1103 Group 3 matches the equals sign, if any. 1104 Group 4 matches single-, double-, or un-quoted attribute values.") 1105 1106 (defconst markdown-regex-html-tag 1107 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr 1108 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") 1109 "Regular expression for matching HTML tags. 1110 Groups 1 and 9 match the beginning and ending angle brackets and slashes. 1111 Group 2 matches the tag name. 1112 Group 3 matches all attributes and whitespace following the tag name.") 1113 1114 (defconst markdown-regex-html-entity 1115 "\\(&#?[[:alnum:]]+;\\)" 1116 "Regular expression for matching HTML entities.") 1117 1118 (defconst markdown-regex-highlighting 1119 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" 1120 "Regular expression for matching highlighting text. 1121 Group 1 matches the character before the opening equal, if any, 1122 ensuring that it is not a backslash escape. 1123 Group 2 matches the entire expression, including delimiters. 1124 Groups 3 and 5 matches the opening and closing delimiters. 1125 Group 4 matches the text inside the delimiters.") 1126 1127 1128 ;;; Syntax ==================================================================== 1129 1130 (defvar markdown--syntax-properties 1131 (list 'markdown-tilde-fence-begin nil 1132 'markdown-tilde-fence-end nil 1133 'markdown-fenced-code nil 1134 'markdown-yaml-metadata-begin nil 1135 'markdown-yaml-metadata-end nil 1136 'markdown-yaml-metadata-section nil 1137 'markdown-gfm-block-begin nil 1138 'markdown-gfm-block-end nil 1139 'markdown-gfm-code nil 1140 'markdown-list-item nil 1141 'markdown-pre nil 1142 'markdown-blockquote nil 1143 'markdown-hr nil 1144 'markdown-comment nil 1145 'markdown-heading nil 1146 'markdown-heading-1-setext nil 1147 'markdown-heading-2-setext nil 1148 'markdown-heading-1-atx nil 1149 'markdown-heading-2-atx nil 1150 'markdown-heading-3-atx nil 1151 'markdown-heading-4-atx nil 1152 'markdown-heading-5-atx nil 1153 'markdown-heading-6-atx nil 1154 'markdown-metadata-key nil 1155 'markdown-metadata-value nil 1156 'markdown-metadata-markup nil) 1157 "Property list of all Markdown syntactic properties.") 1158 1159 (defvar markdown-literal-faces 1160 '(markdown-inline-code-face 1161 markdown-pre-face 1162 markdown-math-face 1163 markdown-url-face 1164 markdown-plain-url-face 1165 markdown-language-keyword-face 1166 markdown-language-info-face 1167 markdown-metadata-key-face 1168 markdown-metadata-value-face 1169 markdown-html-entity-face 1170 markdown-html-tag-name-face 1171 markdown-html-tag-delimiter-face 1172 markdown-html-attr-name-face 1173 markdown-html-attr-value-face 1174 markdown-reference-face 1175 markdown-footnote-marker-face 1176 markdown-line-break-face 1177 markdown-comment-face) 1178 "A list of markdown-mode faces that contain literal text. 1179 Literal text treats backslashes literally, rather than as an 1180 escape character (see `markdown-match-escape').") 1181 1182 (defsubst markdown-in-comment-p (&optional pos) 1183 "Return non-nil if POS is in a comment. 1184 If POS is not given, use point instead." 1185 (get-text-property (or pos (point)) 'markdown-comment)) 1186 1187 (defun markdown--face-p (pos faces) 1188 "Return non-nil if face of POS contain FACES." 1189 (let ((face-prop (get-text-property pos 'face))) 1190 (if (listp face-prop) 1191 (cl-loop for face in face-prop 1192 thereis (memq face faces)) 1193 (memq face-prop faces)))) 1194 1195 (defsubst markdown--math-block-p (&optional pos) 1196 (when markdown-enable-math 1197 (markdown--face-p (or pos (point)) '(markdown-math-face)))) 1198 1199 (defun markdown-syntax-propertize-extend-region (start end) 1200 "Extend START to END region to include an entire block of text. 1201 This helps improve syntax analysis for block constructs. 1202 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. 1203 Function is called repeatedly until it returns nil. For details, see 1204 `syntax-propertize-extend-region-functions'." 1205 (save-match-data 1206 (save-excursion 1207 (let* ((new-start (progn (goto-char start) 1208 (skip-chars-forward "\n") 1209 (if (re-search-backward "\n\n" nil t) 1210 (min start (match-end 0)) 1211 (point-min)))) 1212 (new-end (progn (goto-char end) 1213 (skip-chars-backward "\n") 1214 (if (re-search-forward "\n\n" nil t) 1215 (max end (match-beginning 0)) 1216 (point-max)))) 1217 (code-match (markdown-code-block-at-pos new-start)) 1218 ;; FIXME: The `code-match' can return bogus values 1219 ;; when text has been inserted/deleted! 1220 (new-start (min (or (and code-match (cl-first code-match)) 1221 (point-max)) 1222 new-start)) 1223 (code-match (and (< end (point-max)) 1224 (markdown-code-block-at-pos end))) 1225 (new-end (max (or (and code-match (cl-second code-match)) 0) 1226 new-end))) 1227 1228 (unless (and (eq new-start start) (eq new-end end)) 1229 (cons new-start (min new-end (point-max)))))))) 1230 1231 (defun markdown-font-lock-extend-region-function (start end _) 1232 "Used in `jit-lock-after-change-extend-region-functions'. 1233 Delegates to `markdown-syntax-propertize-extend-region'. START 1234 and END are the previous region to refontify." 1235 (let ((res (markdown-syntax-propertize-extend-region start end))) 1236 (when res 1237 ;; syntax-propertize-function is not called when character at 1238 ;; (point-max) is deleted, but font-lock-extend-region-functions 1239 ;; are called. Force a syntax property update in that case. 1240 (when (= end (point-max)) 1241 ;; This function is called in a buffer modification hook. 1242 ;; `markdown-syntax-propertize' doesn't save the match data, 1243 ;; so we have to do it here. 1244 (save-match-data 1245 (markdown-syntax-propertize (car res) (cdr res)))) 1246 (setq jit-lock-start (car res) 1247 jit-lock-end (cdr res))))) 1248 1249 (defun markdown--cur-list-item-bounds () 1250 "Return a list describing the list item at point. 1251 Assumes that match data is set for `markdown-regex-list'. See the 1252 documentation for `markdown-cur-list-item-bounds' for the format of 1253 the returned list." 1254 (save-excursion 1255 (let* ((begin (match-beginning 0)) 1256 (indent (length (match-string-no-properties 1))) 1257 (nonlist-indent (- (match-end 3) (match-beginning 0))) 1258 (marker (buffer-substring-no-properties 1259 (match-beginning 2) (match-end 3))) 1260 (checkbox (match-string-no-properties 4)) 1261 (match (butlast (match-data t))) 1262 (end (markdown-cur-list-item-end nonlist-indent))) 1263 (list begin end indent nonlist-indent marker checkbox match)))) 1264 1265 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) 1266 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. 1267 Here, MARKER is a string representing the type of list and INDENT 1268 is an integer giving the indentation, in spaces, of the current 1269 block. CUR-BOUNDS is a list of the form returned by 1270 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds 1271 values for parent list items. When BOUNDS is nil, it means we are 1272 at baseline (not inside of a nested list)." 1273 (let ((prev-indent (or (cl-third (car bounds)) 0))) 1274 (cond 1275 ;; New list item at baseline. 1276 ((and marker (null bounds)) 1277 (list cur-bounds)) 1278 ;; List item with greater indentation (four or more spaces). 1279 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. 1280 ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) 1281 (cons cur-bounds bounds)) 1282 ;; List item with greater or equal indentation (less than four spaces). 1283 ;; Keep list level the same by replacing the car of BOUNDS. 1284 ((and marker (>= indent prev-indent)) 1285 (cons cur-bounds (cdr bounds))) 1286 ;; Lesser indentation level. 1287 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser 1288 ;; indentation could move back more than one list level). Note 1289 ;; that this block need not be the beginning of list item. 1290 ((< indent prev-indent) 1291 (while (and (> (length bounds) 1) 1292 (setq prev-indent (cl-third (cadr bounds))) 1293 (< indent (+ prev-indent markdown-list-indent-width))) 1294 (setq bounds (cdr bounds))) 1295 (cons cur-bounds bounds)) 1296 ;; Otherwise, do nothing. 1297 (t bounds)))) 1298 1299 (defun markdown-syntax-propertize-list-items (start end) 1300 "Propertize list items from START to END. 1301 Stores nested list item information in the `markdown-list-item' 1302 text property to make later syntax analysis easier. The value of 1303 this property is a list with elements of the form (begin . end) 1304 giving the bounds of the current and parent list items." 1305 (save-excursion 1306 (goto-char start) 1307 (let ((prev-list-line -100) 1308 bounds level pre-regexp) 1309 ;; Find a baseline point with zero list indentation 1310 (markdown-search-backward-baseline) 1311 ;; Search for all list items between baseline and END 1312 (while (and (< (point) end) 1313 (re-search-forward markdown-regex-list end 'limit)) 1314 ;; Level of list nesting 1315 (setq level (length bounds)) 1316 ;; Pre blocks need to be indented one level past the list level 1317 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) 1318 (beginning-of-line) 1319 (cond 1320 ;; Reset at headings, horizontal rules, and top-level blank lines. 1321 ;; Propertize baseline when in range. 1322 ((markdown-new-baseline) 1323 (setq bounds nil)) 1324 ;; Make sure this is not a line from a pre block 1325 ((and (looking-at-p pre-regexp) 1326 ;; too indented line is also treated as list if previous line is list 1327 (>= (- (line-number-at-pos) prev-list-line) 2))) 1328 ;; If not, then update levels and propertize list item when in range. 1329 (t 1330 (let* ((indent (current-indentation)) 1331 (cur-bounds (markdown--cur-list-item-bounds)) 1332 (first (cl-first cur-bounds)) 1333 (last (cl-second cur-bounds)) 1334 (marker (cl-fifth cur-bounds))) 1335 (setq bounds (markdown--append-list-item-bounds 1336 marker indent cur-bounds bounds)) 1337 (when (and (<= start (point)) (<= (point) end)) 1338 (setq prev-list-line (line-number-at-pos first)) 1339 (put-text-property first last 'markdown-list-item bounds))))) 1340 (end-of-line))))) 1341 1342 (defun markdown-syntax-propertize-pre-blocks (start end) 1343 "Match preformatted text blocks from START to END." 1344 (save-excursion 1345 (goto-char start) 1346 (let (finish) 1347 ;; Use loop for avoiding too many recursive calls 1348 ;; https://github.com/jrblevin/markdown-mode/issues/512 1349 (while (not finish) 1350 (let ((levels (markdown-calculate-list-levels)) 1351 indent pre-regexp close-regexp open close) 1352 (while (and (< (point) end) (not close)) 1353 ;; Search for a region with sufficient indentation 1354 (if (null levels) 1355 (setq indent 1) 1356 (setq indent (1+ (length levels)))) 1357 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) 1358 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) 1359 1360 (cond 1361 ;; If not at the beginning of a line, move forward 1362 ((not (bolp)) (forward-line)) 1363 ;; Move past blank lines 1364 ((markdown-cur-line-blank-p) (forward-line)) 1365 ;; At headers and horizontal rules, reset levels 1366 ((markdown-new-baseline) (forward-line) (setq levels nil)) 1367 ;; If the current line has sufficient indentation, mark out pre block 1368 ;; The opening should be preceded by a blank line. 1369 ((and (markdown-prev-line-blank) (looking-at pre-regexp)) 1370 (setq open (match-beginning 0)) 1371 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) 1372 (not (eobp))) 1373 (forward-line)) 1374 (skip-syntax-backward "-") 1375 (forward-line) 1376 (setq close (point))) 1377 ;; If current line has a list marker, update levels, move to end of block 1378 ((looking-at markdown-regex-list) 1379 (setq levels (markdown-update-list-levels 1380 (match-string 2) (current-indentation) levels)) 1381 (markdown-end-of-text-block)) 1382 ;; If this is the end of the indentation level, adjust levels accordingly. 1383 ;; Only match end of indentation level if levels is not the empty list. 1384 ((and (car levels) (looking-at-p close-regexp)) 1385 (setq levels (markdown-update-list-levels 1386 nil (current-indentation) levels)) 1387 (markdown-end-of-text-block)) 1388 (t (markdown-end-of-text-block)))) 1389 1390 (if (and open close) 1391 ;; Set text property data and continue to search 1392 (put-text-property open close 'markdown-pre (list open close)) 1393 (setq finish t)))) 1394 nil))) 1395 1396 (defconst markdown-fenced-block-pairs 1397 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) 1398 (markdown-make-tilde-fence-regex markdown-tilde-fence-end) 1399 markdown-fenced-code) 1400 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) 1401 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) 1402 markdown-yaml-metadata-section) 1403 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) 1404 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) 1405 markdown-gfm-code)) 1406 "Mapping of regular expressions to \"fenced-block\" constructs. 1407 These constructs are distinguished by having a distinctive start 1408 and end pattern, both of which take up an entire line of text, 1409 but no special pattern to identify text within the fenced 1410 blocks (unlike blockquotes and indented-code sections). 1411 1412 Each element within this list takes the form: 1413 1414 ((START-REGEX-OR-FUN START-PROPERTY) 1415 (END-REGEX-OR-FUN END-PROPERTY) 1416 MIDDLE-PROPERTY) 1417 1418 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a 1419 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no 1420 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument 1421 which is the length of the first group of the START-REGEX-OR-FUN match, which 1422 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to 1423 evaluate these into \"real\" regexps. 1424 1425 The *-PROPERTY elements are the text properties applied to each part of the 1426 block construct when it is matched using 1427 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied 1428 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and 1429 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the 1430 `match-data' when the regexp was matched to the text. In the case of 1431 MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with 1432 begin and end set to the edges of the \"middle\" text. This makes fontification 1433 easier.") 1434 1435 (defun markdown-text-property-at-point (prop) 1436 (get-text-property (point) prop)) 1437 1438 (defsubst markdown-maybe-funcall-regexp (object &optional arg) 1439 (cond ((functionp object) 1440 (if arg (funcall object arg) (funcall object))) 1441 ((stringp object) object) 1442 (t (error "Object cannot be turned into regex")))) 1443 1444 (defsubst markdown-get-start-fence-regexp () 1445 "Return regexp to find all \"start\" sections of fenced block constructs. 1446 Which construct is actually contained in the match must be found separately." 1447 (mapconcat 1448 #'identity 1449 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) 1450 markdown-fenced-block-pairs) 1451 "\\|")) 1452 1453 (defun markdown-get-fenced-block-begin-properties () 1454 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) 1455 1456 (defun markdown-get-fenced-block-end-properties () 1457 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) 1458 1459 (defun markdown-get-fenced-block-middle-properties () 1460 (cl-mapcar #'cl-third markdown-fenced-block-pairs)) 1461 1462 (defun markdown-find-previous-prop (prop &optional lim) 1463 "Find previous place where property PROP is non-nil, up to LIM. 1464 Return a cons of (pos . property). pos is point if point contains 1465 non-nil PROP." 1466 (let ((res 1467 (if (get-text-property (point) prop) (point) 1468 (previous-single-property-change 1469 (point) prop nil (or lim (point-min)))))) 1470 (when (and (not (get-text-property res prop)) 1471 (> res (point-min)) 1472 (get-text-property (1- res) prop)) 1473 (cl-decf res)) 1474 (when (and res (get-text-property res prop)) (cons res prop)))) 1475 1476 (defun markdown-find-next-prop (prop &optional lim) 1477 "Find next place where property PROP is non-nil, up to LIM. 1478 Return a cons of (POS . PROPERTY) where POS is point if point 1479 contains non-nil PROP." 1480 (let ((res 1481 (if (get-text-property (point) prop) (point) 1482 (next-single-property-change 1483 (point) prop nil (or lim (point-max)))))) 1484 (when (and res (get-text-property res prop)) (cons res prop)))) 1485 1486 (defun markdown-min-of-seq (map-fn seq) 1487 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." 1488 (cl-loop for el in seq 1489 with min = 1.0e+INF ; infinity 1490 with min-el = nil 1491 do (let ((res (funcall map-fn el))) 1492 (when (< res min) 1493 (setq min res) 1494 (setq min-el el))) 1495 finally return min-el)) 1496 1497 (defun markdown-max-of-seq (map-fn seq) 1498 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." 1499 (cl-loop for el in seq 1500 with max = -1.0e+INF ; negative infinity 1501 with max-el = nil 1502 do (let ((res (funcall map-fn el))) 1503 (when (and res (> res max)) 1504 (setq max res) 1505 (setq max-el el))) 1506 finally return max-el)) 1507 1508 (defun markdown-find-previous-block () 1509 "Find previous block. 1510 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was 1511 unable to propertize the entire block, but was able to propertize the beginning 1512 of the block. If so, return a cons of (pos . property) where the beginning of 1513 the block was propertized." 1514 (let ((start-pt (point)) 1515 (closest-open 1516 (markdown-max-of-seq 1517 #'car 1518 (cl-remove-if 1519 #'null 1520 (cl-mapcar 1521 #'markdown-find-previous-prop 1522 (markdown-get-fenced-block-begin-properties)))))) 1523 (when closest-open 1524 (let* ((length-of-open-match 1525 (let ((match-d 1526 (get-text-property (car closest-open) (cdr closest-open)))) 1527 (- (cl-fourth match-d) (cl-third match-d)))) 1528 (end-regexp 1529 (markdown-maybe-funcall-regexp 1530 (cl-caadr 1531 (cl-find-if 1532 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) 1533 markdown-fenced-block-pairs)) 1534 length-of-open-match)) 1535 (end-prop-loc 1536 (save-excursion 1537 (save-match-data 1538 (goto-char (car closest-open)) 1539 (and (re-search-forward end-regexp start-pt t) 1540 (match-beginning 0)))))) 1541 (and (not end-prop-loc) closest-open))))) 1542 1543 (defun markdown-get-fenced-block-from-start (prop) 1544 "Return limits of an enclosing fenced block from its start, using PROP. 1545 Return value is a list usable as `match-data'." 1546 (catch 'no-rest-of-block 1547 (let* ((correct-entry 1548 (cl-find-if 1549 (lambda (entry) (eq (cl-cadar entry) prop)) 1550 markdown-fenced-block-pairs)) 1551 (begin-of-begin (cl-first (markdown-text-property-at-point prop))) 1552 (middle-prop (cl-third correct-entry)) 1553 (end-prop (cl-cadadr correct-entry)) 1554 (end-of-end 1555 (save-excursion 1556 (goto-char (match-end 0)) ; end of begin 1557 (unless (eobp) (forward-char)) 1558 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1559 (if (not mid-prop-v) ; no middle 1560 (progn 1561 ;; try to find end by advancing one 1562 (let ((end-prop-v 1563 (markdown-text-property-at-point end-prop))) 1564 (if end-prop-v (cl-second end-prop-v) 1565 (throw 'no-rest-of-block nil)))) 1566 (set-match-data mid-prop-v) 1567 (goto-char (match-end 0)) ; end of middle 1568 (beginning-of-line) ; into end 1569 (cl-second (markdown-text-property-at-point end-prop))))))) 1570 (list begin-of-begin end-of-end)))) 1571 1572 (defun markdown-get-fenced-block-from-middle (prop) 1573 "Return limits of an enclosing fenced block from its middle, using PROP. 1574 Return value is a list usable as `match-data'." 1575 (let* ((correct-entry 1576 (cl-find-if 1577 (lambda (entry) (eq (cl-third entry) prop)) 1578 markdown-fenced-block-pairs)) 1579 (begin-prop (cl-cadar correct-entry)) 1580 (begin-of-begin 1581 (save-excursion 1582 (goto-char (match-beginning 0)) 1583 (unless (bobp) (forward-line -1)) 1584 (beginning-of-line) 1585 (cl-first (markdown-text-property-at-point begin-prop)))) 1586 (end-prop (cl-cadadr correct-entry)) 1587 (end-of-end 1588 (save-excursion 1589 (goto-char (match-end 0)) 1590 (beginning-of-line) 1591 (cl-second (markdown-text-property-at-point end-prop))))) 1592 (list begin-of-begin end-of-end))) 1593 1594 (defun markdown-get-fenced-block-from-end (prop) 1595 "Return limits of an enclosing fenced block from its end, using PROP. 1596 Return value is a list usable as `match-data'." 1597 (let* ((correct-entry 1598 (cl-find-if 1599 (lambda (entry) (eq (cl-cadadr entry) prop)) 1600 markdown-fenced-block-pairs)) 1601 (end-of-end (cl-second (markdown-text-property-at-point prop))) 1602 (middle-prop (cl-third correct-entry)) 1603 (begin-prop (cl-cadar correct-entry)) 1604 (begin-of-begin 1605 (save-excursion 1606 (goto-char (match-beginning 0)) ; beginning of end 1607 (unless (bobp) (backward-char)) ; into middle 1608 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1609 (if (not mid-prop-v) 1610 (progn 1611 (beginning-of-line) 1612 (cl-first (markdown-text-property-at-point begin-prop))) 1613 (set-match-data mid-prop-v) 1614 (goto-char (match-beginning 0)) ; beginning of middle 1615 (unless (bobp) (forward-line -1)) ; into beginning 1616 (beginning-of-line) 1617 (cl-first (markdown-text-property-at-point begin-prop))))))) 1618 (list begin-of-begin end-of-end))) 1619 1620 (defun markdown-get-enclosing-fenced-block-construct (&optional pos) 1621 "Get \"fake\" match data for block enclosing POS. 1622 Returns fake match data which encloses the start, middle, and end 1623 of the block construct enclosing POS, if it exists. Used in 1624 `markdown-code-block-at-pos'." 1625 (save-excursion 1626 (when pos (goto-char pos)) 1627 (beginning-of-line) 1628 (car 1629 (cl-remove-if 1630 #'null 1631 (cl-mapcar 1632 (lambda (fun-and-prop) 1633 (cl-destructuring-bind (fun prop) fun-and-prop 1634 (when prop 1635 (save-match-data 1636 (set-match-data (markdown-text-property-at-point prop)) 1637 (funcall fun prop))))) 1638 `((markdown-get-fenced-block-from-start 1639 ,(cl-find-if 1640 #'markdown-text-property-at-point 1641 (markdown-get-fenced-block-begin-properties))) 1642 (markdown-get-fenced-block-from-middle 1643 ,(cl-find-if 1644 #'markdown-text-property-at-point 1645 (markdown-get-fenced-block-middle-properties))) 1646 (markdown-get-fenced-block-from-end 1647 ,(cl-find-if 1648 #'markdown-text-property-at-point 1649 (markdown-get-fenced-block-end-properties))))))))) 1650 1651 (defun markdown-propertize-end-match (reg end fence-spec middle-begin) 1652 "Get match for REG up to END, if exists, and propertize appropriately. 1653 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and 1654 MIDDLE-BEGIN is the start of the \"middle\" section of the block." 1655 (when (re-search-forward reg end t) 1656 (let ((close-begin (match-beginning 0)) ; Start of closing line. 1657 (close-end (match-end 0)) ; End of closing line. 1658 (close-data (match-data t))) ; Match data for closing line. 1659 ;; Propertize middle section of fenced block. 1660 (put-text-property middle-begin close-begin 1661 (cl-third fence-spec) 1662 (list middle-begin close-begin)) 1663 ;; If the block is a YAML block, propertize the declarations inside 1664 (when (< middle-begin close-begin) ;; workaround #634 1665 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) 1666 ;; Propertize closing line of fenced block. 1667 (put-text-property close-begin close-end 1668 (cl-cadadr fence-spec) close-data)))) 1669 1670 (defun markdown--triple-quote-single-line-p (begin) 1671 (save-excursion 1672 (goto-char begin) 1673 (save-match-data 1674 (and (search-forward "```" nil t) 1675 (search-forward "```" (line-end-position) t))))) 1676 1677 (defun markdown-syntax-propertize-fenced-block-constructs (start end) 1678 "Propertize according to `markdown-fenced-block-pairs' from START to END. 1679 If unable to propertize an entire block (if the start of a block is within START 1680 and END, but the end of the block is not), propertize the start section of a 1681 block, then in a subsequent call propertize both middle and end by finding the 1682 start which was previously propertized." 1683 (let ((start-reg (markdown-get-start-fence-regexp))) 1684 (save-excursion 1685 (goto-char start) 1686 ;; start from previous unclosed block, if exists 1687 (let ((prev-begin-block (markdown-find-previous-block))) 1688 (when prev-begin-block 1689 (let* ((correct-entry 1690 (cl-find-if (lambda (entry) 1691 (eq (cdr prev-begin-block) (cl-cadar entry))) 1692 markdown-fenced-block-pairs)) 1693 (enclosed-text-start (1+ (car prev-begin-block))) 1694 (start-length 1695 (save-excursion 1696 (goto-char (car prev-begin-block)) 1697 (string-match 1698 (markdown-maybe-funcall-regexp 1699 (caar correct-entry)) 1700 (buffer-substring 1701 (line-beginning-position) (line-end-position))) 1702 (- (match-end 1) (match-beginning 1)))) 1703 (end-reg (markdown-maybe-funcall-regexp 1704 (cl-caadr correct-entry) start-length))) 1705 (markdown-propertize-end-match 1706 end-reg end correct-entry enclosed-text-start)))) 1707 ;; find all new blocks within region 1708 (while (re-search-forward start-reg end t) 1709 ;; we assume the opening constructs take up (only) an entire line, 1710 ;; so we re-check the current line 1711 (let* ((block-start (match-beginning 0)) 1712 (cur-line (buffer-substring (line-beginning-position) (line-end-position))) 1713 ;; find entry in `markdown-fenced-block-pairs' corresponding 1714 ;; to regex which was matched 1715 (correct-entry 1716 (cl-find-if 1717 (lambda (fenced-pair) 1718 (string-match-p 1719 (markdown-maybe-funcall-regexp (caar fenced-pair)) 1720 cur-line)) 1721 markdown-fenced-block-pairs)) 1722 (enclosed-text-start 1723 (save-excursion (1+ (line-end-position)))) 1724 (end-reg 1725 (markdown-maybe-funcall-regexp 1726 (cl-caadr correct-entry) 1727 (if (and (match-beginning 1) (match-end 1)) 1728 (- (match-end 1) (match-beginning 1)) 1729 0))) 1730 (prop (cl-cadar correct-entry))) 1731 (when (or (not (eq prop 'markdown-gfm-block-begin)) 1732 (not (markdown--triple-quote-single-line-p block-start))) 1733 ;; get correct match data 1734 (save-excursion 1735 (beginning-of-line) 1736 (re-search-forward 1737 (markdown-maybe-funcall-regexp (caar correct-entry)) 1738 (line-end-position))) 1739 ;; mark starting, even if ending is outside of region 1740 (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) 1741 (markdown-propertize-end-match 1742 end-reg end correct-entry enclosed-text-start))))))) 1743 1744 (defun markdown-syntax-propertize-blockquotes (start end) 1745 "Match blockquotes from START to END." 1746 (save-excursion 1747 (goto-char start) 1748 (while (and (re-search-forward markdown-regex-blockquote end t) 1749 (not (markdown-code-block-at-pos (match-beginning 0)))) 1750 (put-text-property (match-beginning 0) (match-end 0) 1751 'markdown-blockquote 1752 (match-data t))))) 1753 1754 (defun markdown-syntax-propertize-hrs (start end) 1755 "Match horizontal rules from START to END." 1756 (save-excursion 1757 (goto-char start) 1758 (while (re-search-forward markdown-regex-hr end t) 1759 (let ((beg (match-beginning 0)) 1760 (end (match-end 0))) 1761 (goto-char beg) 1762 (unless (or (markdown-on-heading-p) 1763 (markdown-code-block-at-point-p)) 1764 (put-text-property beg end 'markdown-hr (match-data t))) 1765 (goto-char end))))) 1766 1767 (defun markdown-syntax-propertize-yaml-metadata (start end) 1768 "Propertize elements inside YAML metadata blocks from START to END. 1769 Assumes region from START and END is already known to be the interior 1770 region of a YAML metadata block as propertized by 1771 `markdown-syntax-propertize-fenced-block-constructs'." 1772 (save-excursion 1773 (goto-char start) 1774 (cl-loop 1775 while (re-search-forward markdown-regex-declarative-metadata end t) 1776 do (progn 1777 (put-text-property (match-beginning 1) (match-end 1) 1778 'markdown-metadata-key (match-data t)) 1779 (put-text-property (match-beginning 2) (match-end 2) 1780 'markdown-metadata-markup (match-data t)) 1781 (put-text-property (match-beginning 3) (match-end 3) 1782 'markdown-metadata-value (match-data t)))))) 1783 1784 (defun markdown-syntax-propertize-headings (start end) 1785 "Match headings of type SYMBOL with REGEX from START to END." 1786 (goto-char start) 1787 (while (re-search-forward markdown-regex-header end t) 1788 (unless (markdown-code-block-at-pos (match-beginning 0)) 1789 (put-text-property 1790 (match-beginning 0) (match-end 0) 'markdown-heading 1791 (match-data t)) 1792 (put-text-property 1793 (match-beginning 0) (match-end 0) 1794 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) 1795 ((match-string-no-properties 3) 'markdown-heading-2-setext) 1796 (t (let ((atx-level (length (markdown-trim-whitespace 1797 (match-string-no-properties 4))))) 1798 (intern (format "markdown-heading-%d-atx" atx-level))))) 1799 (match-data t))))) 1800 1801 (defun markdown-syntax-propertize-comments (start end) 1802 "Match HTML comments from the START to END." 1803 ;; Implement by loop instead of recursive call for avoiding 1804 ;; exceed max-lisp-eval-depth issue 1805 ;; https://github.com/jrblevin/markdown-mode/issues/536 1806 (let (finish) 1807 (goto-char start) 1808 (while (not finish) 1809 (let* ((in-comment (nth 4 (syntax-ppss))) 1810 (comment-begin (nth 8 (syntax-ppss)))) 1811 (cond 1812 ;; Comment start 1813 ((and (not in-comment) 1814 (re-search-forward markdown-regex-comment-start end t) 1815 (not (markdown-inline-code-at-point-p)) 1816 (not (markdown-code-block-at-point-p))) 1817 (let ((open-beg (match-beginning 0))) 1818 (put-text-property open-beg (1+ open-beg) 1819 'syntax-table (string-to-syntax "<")) 1820 (goto-char (min (1+ (match-end 0)) end (point-max))))) 1821 ;; Comment end 1822 ((and in-comment comment-begin 1823 (re-search-forward markdown-regex-comment-end end t)) 1824 (let ((comment-end (match-end 0))) 1825 (put-text-property (1- comment-end) comment-end 1826 'syntax-table (string-to-syntax ">")) 1827 ;; Remove any other text properties inside the comment 1828 (remove-text-properties comment-begin comment-end 1829 markdown--syntax-properties) 1830 (put-text-property comment-begin comment-end 1831 'markdown-comment (list comment-begin comment-end)) 1832 (goto-char (min comment-end end (point-max))))) 1833 ;; Nothing found 1834 (t (setq finish t))))) 1835 nil)) 1836 1837 (defun markdown-syntax-propertize (start end) 1838 "Function used as `syntax-propertize-function'. 1839 START and END delimit region to propertize." 1840 (with-silent-modifications 1841 (save-excursion 1842 (remove-text-properties start end markdown--syntax-properties) 1843 (markdown-syntax-propertize-fenced-block-constructs start end) 1844 (markdown-syntax-propertize-list-items start end) 1845 (markdown-syntax-propertize-pre-blocks start end) 1846 (markdown-syntax-propertize-blockquotes start end) 1847 (markdown-syntax-propertize-headings start end) 1848 (markdown-syntax-propertize-hrs start end) 1849 (markdown-syntax-propertize-comments start end)))) 1850 1851 1852 ;;; Markup Hiding ============================================================= 1853 1854 (defconst markdown-markup-properties 1855 '(face markdown-markup-face invisible markdown-markup) 1856 "List of properties and values to apply to markup.") 1857 1858 (defconst markdown-line-break-properties 1859 '(face markdown-line-break-face invisible markdown-markup) 1860 "List of properties and values to apply to line break markup.") 1861 1862 (defconst markdown-language-keyword-properties 1863 '(face markdown-language-keyword-face invisible markdown-markup) 1864 "List of properties and values to apply to code block language names.") 1865 1866 (defconst markdown-language-info-properties 1867 '(face markdown-language-info-face invisible markdown-markup) 1868 "List of properties and values to apply to code block language info strings.") 1869 1870 (defconst markdown-include-title-properties 1871 '(face markdown-link-title-face invisible markdown-markup) 1872 "List of properties and values to apply to included code titles.") 1873 1874 (defcustom markdown-hide-markup nil 1875 "Determines whether markup in the buffer will be hidden. 1876 When set to nil, all markup is displayed in the buffer as it 1877 appears in the file. An exception is when `markdown-hide-urls' 1878 is non-nil. 1879 Set this to a non-nil value to turn this feature on by default. 1880 You can interactively toggle the value of this variable with 1881 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], 1882 or from the Markdown > Show & Hide menu. 1883 1884 Markup hiding works by adding text properties to positions in the 1885 buffer---either the `invisible' property or the `display' property 1886 in cases where alternative glyphs are used (e.g., list bullets). 1887 This does not, however, affect printing or other output. 1888 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will 1889 not honor these text properties. For printing, it would be better 1890 to first convert to HTML or PDF (e.g,. using Pandoc)." 1891 :group 'markdown 1892 :type 'boolean 1893 :safe 'booleanp 1894 :package-version '(markdown-mode . "2.3")) 1895 (make-variable-buffer-local 'markdown-hide-markup) 1896 1897 (defun markdown-toggle-markup-hiding (&optional arg) 1898 "Toggle the display or hiding of markup. 1899 With a prefix argument ARG, enable markup hiding if ARG is positive, 1900 and disable it otherwise. 1901 See `markdown-hide-markup' for additional details." 1902 (interactive (list (or current-prefix-arg 'toggle))) 1903 (setq markdown-hide-markup 1904 (if (eq arg 'toggle) 1905 (not markdown-hide-markup) 1906 (> (prefix-numeric-value arg) 0))) 1907 (if markdown-hide-markup 1908 (progn (add-to-invisibility-spec 'markdown-markup) 1909 (message "markdown-mode markup hiding enabled")) 1910 (progn (remove-from-invisibility-spec 'markdown-markup) 1911 (message "markdown-mode markup hiding disabled"))) 1912 (markdown-reload-extensions)) 1913 1914 1915 ;;; Font Lock ================================================================= 1916 1917 (require 'font-lock) 1918 1919 (defgroup markdown-faces nil 1920 "Faces used in Markdown Mode." 1921 :group 'markdown 1922 :group 'faces) 1923 1924 (defface markdown-italic-face 1925 '((t (:inherit italic))) 1926 "Face for italic text." 1927 :group 'markdown-faces) 1928 1929 (defface markdown-bold-face 1930 '((t (:inherit bold))) 1931 "Face for bold text." 1932 :group 'markdown-faces) 1933 1934 (defface markdown-strike-through-face 1935 '((t (:strike-through t))) 1936 "Face for strike-through text." 1937 :group 'markdown-faces) 1938 1939 (defface markdown-markup-face 1940 '((t (:inherit shadow :slant normal :weight normal))) 1941 "Face for markup elements." 1942 :group 'markdown-faces) 1943 1944 (defface markdown-header-rule-face 1945 '((t (:inherit markdown-markup-face))) 1946 "Base face for headers rules." 1947 :group 'markdown-faces) 1948 1949 (defface markdown-header-delimiter-face 1950 '((t (:inherit markdown-markup-face))) 1951 "Base face for headers hash delimiter." 1952 :group 'markdown-faces) 1953 1954 (defface markdown-list-face 1955 '((t (:inherit markdown-markup-face))) 1956 "Face for list item markers." 1957 :group 'markdown-faces) 1958 1959 (defface markdown-blockquote-face 1960 '((t (:inherit font-lock-doc-face))) 1961 "Face for blockquote sections." 1962 :group 'markdown-faces) 1963 1964 (defface markdown-code-face 1965 '((t (:inherit fixed-pitch))) 1966 "Face for inline code, pre blocks, and fenced code blocks. 1967 This may be used, for example, to add a contrasting background to 1968 inline code fragments and code blocks." 1969 :group 'markdown-faces) 1970 1971 (defface markdown-inline-code-face 1972 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1973 "Face for inline code." 1974 :group 'markdown-faces) 1975 1976 (defface markdown-pre-face 1977 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1978 "Face for preformatted text." 1979 :group 'markdown-faces) 1980 1981 (defface markdown-table-face 1982 '((t (:inherit (markdown-code-face)))) 1983 "Face for tables." 1984 :group 'markdown-faces) 1985 1986 (defface markdown-language-keyword-face 1987 '((t (:inherit font-lock-type-face))) 1988 "Face for programming language identifiers." 1989 :group 'markdown-faces) 1990 1991 (defface markdown-language-info-face 1992 '((t (:inherit font-lock-string-face))) 1993 "Face for programming language info strings." 1994 :group 'markdown-faces) 1995 1996 (defface markdown-link-face 1997 '((t (:inherit link))) 1998 "Face for links." 1999 :group 'markdown-faces) 2000 2001 (defface markdown-missing-link-face 2002 '((t (:inherit font-lock-warning-face))) 2003 "Face for missing links." 2004 :group 'markdown-faces) 2005 2006 (defface markdown-reference-face 2007 '((t (:inherit markdown-markup-face))) 2008 "Face for link references." 2009 :group 'markdown-faces) 2010 2011 (defface markdown-footnote-marker-face 2012 '((t (:inherit markdown-markup-face))) 2013 "Face for footnote markers." 2014 :group 'markdown-faces) 2015 2016 (defface markdown-footnote-text-face 2017 '((t (:inherit font-lock-comment-face))) 2018 "Face for footnote text." 2019 :group 'markdown-faces) 2020 2021 (defface markdown-url-face 2022 '((t (:inherit font-lock-string-face))) 2023 "Face for URLs that are part of markup. 2024 For example, this applies to URLs in inline links: 2025 [link text](http://example.com/)." 2026 :group 'markdown-faces) 2027 2028 (defface markdown-plain-url-face 2029 '((t (:inherit markdown-link-face))) 2030 "Face for URLs that are also links. 2031 For example, this applies to plain angle bracket URLs: 2032 <http://example.com/>." 2033 :group 'markdown-faces) 2034 2035 (defface markdown-link-title-face 2036 '((t (:inherit font-lock-comment-face))) 2037 "Face for reference link titles." 2038 :group 'markdown-faces) 2039 2040 (defface markdown-line-break-face 2041 '((t (:inherit font-lock-constant-face :underline t))) 2042 "Face for hard line breaks." 2043 :group 'markdown-faces) 2044 2045 (defface markdown-comment-face 2046 '((t (:inherit font-lock-comment-face))) 2047 "Face for HTML comments." 2048 :group 'markdown-faces) 2049 2050 (defface markdown-math-face 2051 '((t (:inherit font-lock-string-face))) 2052 "Face for LaTeX expressions." 2053 :group 'markdown-faces) 2054 2055 (defface markdown-metadata-key-face 2056 '((t (:inherit font-lock-variable-name-face))) 2057 "Face for metadata keys." 2058 :group 'markdown-faces) 2059 2060 (defface markdown-metadata-value-face 2061 '((t (:inherit font-lock-string-face))) 2062 "Face for metadata values." 2063 :group 'markdown-faces) 2064 2065 (defface markdown-gfm-checkbox-face 2066 '((t (:inherit font-lock-builtin-face))) 2067 "Face for GFM checkboxes." 2068 :group 'markdown-faces) 2069 2070 (defface markdown-highlight-face 2071 '((t (:inherit highlight))) 2072 "Face for mouse highlighting." 2073 :group 'markdown-faces) 2074 2075 (defface markdown-hr-face 2076 '((t (:inherit markdown-markup-face))) 2077 "Face for horizontal rules." 2078 :group 'markdown-faces) 2079 2080 (defface markdown-html-tag-name-face 2081 '((t (:inherit font-lock-type-face))) 2082 "Face for HTML tag names." 2083 :group 'markdown-faces) 2084 2085 (defface markdown-html-tag-delimiter-face 2086 '((t (:inherit markdown-markup-face))) 2087 "Face for HTML tag delimiters." 2088 :group 'markdown-faces) 2089 2090 (defface markdown-html-attr-name-face 2091 '((t (:inherit font-lock-variable-name-face))) 2092 "Face for HTML attribute names." 2093 :group 'markdown-faces) 2094 2095 (defface markdown-html-attr-value-face 2096 '((t (:inherit font-lock-string-face))) 2097 "Face for HTML attribute values." 2098 :group 'markdown-faces) 2099 2100 (defface markdown-html-entity-face 2101 '((t (:inherit font-lock-variable-name-face))) 2102 "Face for HTML entities." 2103 :group 'markdown-faces) 2104 2105 (defface markdown-highlighting-face 2106 '((t (:background "yellow" :foreground "black"))) 2107 "Face for highlighting." 2108 :group 'markdown-faces) 2109 2110 (defcustom markdown-header-scaling nil 2111 "Whether to use variable-height faces for headers. 2112 When non-nil, `markdown-header-face' will inherit from 2113 `variable-pitch' and the scaling values in 2114 `markdown-header-scaling-values' will be applied to 2115 headers of levels one through six respectively." 2116 :type 'boolean 2117 :initialize #'custom-initialize-default 2118 :set (lambda (symbol value) 2119 (set-default symbol value) 2120 (markdown-update-header-faces value)) 2121 :group 'markdown-faces 2122 :package-version '(markdown-mode . "2.2")) 2123 2124 (defcustom markdown-header-scaling-values 2125 '(2.0 1.7 1.4 1.1 1.0 1.0) 2126 "List of scaling values for headers of level one through six. 2127 Used when `markdown-header-scaling' is non-nil." 2128 :type '(repeat float) 2129 :initialize #'custom-initialize-default 2130 :set (lambda (symbol value) 2131 (set-default symbol value) 2132 (markdown-update-header-faces markdown-header-scaling value))) 2133 2134 (defmacro markdown--dotimes-when-compile (i-n body) 2135 (declare (indent 1) (debug ((symbolp form) form))) 2136 (let ((var (car i-n)) 2137 (n (cadr i-n)) 2138 (code ())) 2139 (dotimes (i (eval n t)) 2140 (push (eval body `((,var . ,i))) code)) 2141 `(progn ,@(nreverse code)))) 2142 2143 (defface markdown-header-face 2144 `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) 2145 font-lock-function-name-face) 2146 :weight bold))) 2147 "Base face for headers.") 2148 2149 (markdown--dotimes-when-compile (num 6) 2150 (let* ((num1 (1+ num)) 2151 (face-name (intern (format "markdown-header-face-%s" num1)))) 2152 `(defface ,face-name 2153 (,'\` ((t (:inherit markdown-header-face 2154 :height 2155 (,'\, (if markdown-header-scaling 2156 (float (nth ,num markdown-header-scaling-values)) 2157 1.0)))))) 2158 (format "Face for level %s headers. 2159 You probably don't want to customize this face directly. Instead 2160 you can customize the base face `markdown-header-face' or the 2161 variable-height variable `markdown-header-scaling'." ,num1)))) 2162 2163 (defun markdown-update-header-faces (&optional scaling scaling-values) 2164 "Update header faces, depending on if header SCALING is desired. 2165 If so, use given list of SCALING-VALUES relative to the baseline 2166 size of `markdown-header-face'." 2167 (dotimes (num 6) 2168 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) 2169 (scale (cond ((not scaling) 1.0) 2170 (scaling-values (float (nth num scaling-values))) 2171 (t (float (nth num markdown-header-scaling-values)))))) 2172 (unless (get face-name 'saved-face) ; Don't update customized faces 2173 (set-face-attribute face-name nil :height scale))))) 2174 2175 (defun markdown-syntactic-face (state) 2176 "Return font-lock face for characters with given STATE. 2177 See `font-lock-syntactic-face-function' for details." 2178 (let ((in-comment (nth 4 state))) 2179 (cond 2180 (in-comment 'markdown-comment-face) 2181 (t nil)))) 2182 2183 (defcustom markdown-list-item-bullets 2184 '("●" "◎" "○" "◆" "◇" "►" "•") 2185 "List of bullets to use for unordered lists. 2186 It can contain any number of symbols, which will be repeated. 2187 Depending on your font, some reasonable choices are: 2188 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." 2189 :group 'markdown 2190 :type '(repeat (string :tag "Bullet character")) 2191 :package-version '(markdown-mode . "2.3")) 2192 2193 (defun markdown--footnote-marker-properties () 2194 "Return a font-lock facespec expression for footnote marker text." 2195 `(face markdown-footnote-marker-face 2196 ,@(when markdown-hide-markup 2197 `(display ,markdown-footnote-display)))) 2198 2199 (defun markdown--pandoc-inline-footnote-properties () 2200 "Return a font-lock facespec expression for Pandoc inline footnote text." 2201 `(face markdown-footnote-text-face 2202 ,@(when markdown-hide-markup 2203 `(display ,markdown-footnote-display)))) 2204 2205 (defvar markdown-mode-font-lock-keywords 2206 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) 2207 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) 2208 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) 2209 (2 'markdown-markup-face) 2210 (3 'markdown-metadata-value-face))) 2211 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) 2212 (2 markdown-markup-properties nil t) 2213 (3 markdown-language-keyword-properties nil t) 2214 (4 markdown-language-info-properties nil t) 2215 (5 markdown-markup-properties nil t))) 2216 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) 2217 (markdown-fontify-gfm-code-blocks) 2218 (markdown-fontify-tables) 2219 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) 2220 (2 markdown-markup-properties nil t) 2221 (3 markdown-language-keyword-properties nil t) 2222 (4 markdown-language-info-properties nil t) 2223 (5 markdown-markup-properties nil t))) 2224 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) 2225 (markdown-fontify-fenced-code-blocks) 2226 (markdown-match-pre-blocks . ((0 'markdown-pre-face))) 2227 (markdown-fontify-headings) 2228 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) 2229 (2 'markdown-markup-face) 2230 (3 'markdown-metadata-value-face))) 2231 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) 2232 (2 'markdown-markup-face) 2233 (3 'markdown-metadata-value-face))) 2234 (markdown-fontify-hrs) 2235 (markdown-match-code . ((1 markdown-markup-properties prepend) 2236 (2 'markdown-inline-code-face prepend) 2237 (3 markdown-markup-properties prepend))) 2238 (,markdown-regex-kbd . ((1 markdown-markup-properties) 2239 (2 'markdown-inline-code-face) 2240 (3 markdown-markup-properties))) 2241 (markdown-fontify-angle-uris) 2242 (,markdown-regex-email . 'markdown-plain-url-face) 2243 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) 2244 (2 'markdown-html-tag-name-face t) 2245 (3 'markdown-html-tag-delimiter-face t) 2246 ;; Anchored matcher for HTML tag attributes 2247 (,markdown-regex-html-attr 2248 ;; Before searching, move past tag 2249 ;; name; set limit at tag close. 2250 (progn 2251 (goto-char (match-end 2)) (match-end 3)) 2252 nil 2253 . ((1 'markdown-html-attr-name-face) 2254 (3 'markdown-html-tag-delimiter-face nil t) 2255 (4 'markdown-html-attr-value-face nil t))))) 2256 (,markdown-regex-html-entity . 'markdown-html-entity-face) 2257 (markdown-fontify-list-items) 2258 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ 2259 (2 (markdown--footnote-marker-properties)) ; label 2260 (3 markdown-markup-properties))) ; ] 2261 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ 2262 (2 markdown-markup-properties) ; [ 2263 (3 (markdown--pandoc-inline-footnote-properties)) ; text 2264 (4 markdown-markup-properties))) ; ] 2265 (markdown-match-includes . ((1 markdown-markup-properties) 2266 (2 markdown-markup-properties nil t) 2267 (3 markdown-include-title-properties nil t) 2268 (4 markdown-markup-properties nil t) 2269 (5 markdown-markup-properties) 2270 (6 'markdown-url-face) 2271 (7 markdown-markup-properties))) 2272 (markdown-fontify-inline-links) 2273 (markdown-fontify-reference-links) 2274 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ 2275 (2 'markdown-reference-face) ; label 2276 (3 'markdown-markup-face) ; ] 2277 (4 'markdown-markup-face) ; : 2278 (5 'markdown-url-face) ; url 2279 (6 'markdown-link-title-face))) ; "title" (optional) 2280 (markdown-fontify-plain-uris) 2281 ;; Math mode $..$ 2282 (markdown-match-math-single . ((1 'markdown-markup-face prepend) 2283 (2 'markdown-math-face append) 2284 (3 'markdown-markup-face prepend))) 2285 ;; Math mode $$..$$ 2286 (markdown-match-math-double . ((1 'markdown-markup-face prepend) 2287 (2 'markdown-math-face append) 2288 (3 'markdown-markup-face prepend))) 2289 ;; Math mode \[..\] and \\[..\\] 2290 (markdown-match-math-display . ((1 'markdown-markup-face prepend) 2291 (3 'markdown-math-face append) 2292 (4 'markdown-markup-face prepend))) 2293 (markdown-match-bold . ((1 markdown-markup-properties prepend) 2294 (2 'markdown-bold-face append) 2295 (3 markdown-markup-properties prepend))) 2296 (markdown-match-italic . ((1 markdown-markup-properties prepend) 2297 (2 'markdown-italic-face append) 2298 (3 markdown-markup-properties prepend))) 2299 (,markdown-regex-strike-through . ((3 markdown-markup-properties) 2300 (4 'markdown-strike-through-face) 2301 (5 markdown-markup-properties))) 2302 (markdown--match-highlighting . ((3 markdown-markup-properties) 2303 (4 'markdown-highlighting-face) 2304 (5 markdown-markup-properties))) 2305 (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) 2306 (markdown-match-escape . ((1 markdown-markup-properties prepend))) 2307 (markdown-fontify-sub-superscripts) 2308 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) 2309 (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) 2310 (markdown-fontify-blockquotes) 2311 (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) 2312 "Syntax highlighting for Markdown files.") 2313 2314 ;; Footnotes 2315 (defvar-local markdown-footnote-counter 0 2316 "Counter for footnote numbers.") 2317 2318 (defconst markdown-footnote-chars 2319 "[[:alnum:]-]" 2320 "Regular expression matching any character for a footnote identifier.") 2321 2322 (defconst markdown-regex-footnote-definition 2323 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") 2324 "Regular expression matching a footnote definition, capturing the label.") 2325 2326 2327 ;;; Compatibility ============================================================= 2328 2329 (defun markdown--pandoc-reference-p () 2330 (let ((bounds (bounds-of-thing-at-point 'word))) 2331 (when (and bounds (char-before (car bounds))) 2332 (= (char-before (car bounds)) ?@)))) 2333 2334 (defun markdown-flyspell-check-word-p () 2335 "Return t if `flyspell' should check word just before point. 2336 Used for `flyspell-generic-check-word-predicate'." 2337 (save-excursion 2338 (goto-char (1- (point))) 2339 ;; https://github.com/jrblevin/markdown-mode/issues/560 2340 ;; enable spell check YAML meta data 2341 (if (or (and (markdown-code-block-at-point-p) 2342 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) 2343 (markdown-inline-code-at-point-p) 2344 (markdown-in-comment-p) 2345 (markdown--face-p (point) '(markdown-reference-face 2346 markdown-markup-face 2347 markdown-plain-url-face 2348 markdown-inline-code-face 2349 markdown-url-face)) 2350 (markdown--pandoc-reference-p)) 2351 (prog1 nil 2352 ;; If flyspell overlay is put, then remove it 2353 (let ((bounds (bounds-of-thing-at-point 'word))) 2354 (when bounds 2355 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) 2356 when (overlay-get ov 'flyspell-overlay) 2357 do 2358 (delete-overlay ov))))) 2359 t))) 2360 2361 2362 ;;; Markdown Parsing Functions ================================================ 2363 2364 (defun markdown-cur-line-blank-p () 2365 "Return t if the current line is blank and nil otherwise." 2366 (save-excursion 2367 (beginning-of-line) 2368 (looking-at-p markdown-regex-blank-line))) 2369 2370 (defun markdown-prev-line-blank () 2371 "Return t if the previous line is blank and nil otherwise. 2372 If we are at the first line, then consider the previous line to be blank." 2373 (or (= (line-beginning-position) (point-min)) 2374 (save-excursion 2375 (forward-line -1) 2376 (looking-at markdown-regex-blank-line)))) 2377 2378 (defun markdown-prev-line-blank-p () 2379 "Like `markdown-prev-line-blank', but preserve `match-data'." 2380 (save-match-data (markdown-prev-line-blank))) 2381 2382 (defun markdown-next-line-blank-p () 2383 "Return t if the next line is blank and nil otherwise. 2384 If we are at the last line, then consider the next line to be blank." 2385 (or (= (line-end-position) (point-max)) 2386 (save-excursion 2387 (forward-line 1) 2388 (markdown-cur-line-blank-p)))) 2389 2390 (defun markdown-prev-line-indent () 2391 "Return the number of leading whitespace characters in the previous line. 2392 Return 0 if the current line is the first line in the buffer." 2393 (save-excursion 2394 (if (= (line-beginning-position) (point-min)) 2395 0 2396 (forward-line -1) 2397 (current-indentation)))) 2398 2399 (defun markdown-next-line-indent () 2400 "Return the number of leading whitespace characters in the next line. 2401 Return 0 if line is the last line in the buffer." 2402 (save-excursion 2403 (if (= (line-end-position) (point-max)) 2404 0 2405 (forward-line 1) 2406 (current-indentation)))) 2407 2408 (defun markdown-new-baseline () 2409 "Determine if the current line begins a new baseline level. 2410 Assume point is positioned at beginning of line." 2411 (or (looking-at markdown-regex-header) 2412 (looking-at markdown-regex-hr) 2413 (and (= (current-indentation) 0) 2414 (not (looking-at markdown-regex-list)) 2415 (markdown-prev-line-blank)))) 2416 2417 (defun markdown-search-backward-baseline () 2418 "Search backward baseline point with no indentation and not a list item." 2419 (end-of-line) 2420 (let (stop) 2421 (while (not (or stop (bobp))) 2422 (re-search-backward markdown-regex-block-separator-noindent nil t) 2423 (when (match-end 2) 2424 (goto-char (match-end 2)) 2425 (cond 2426 ((markdown-new-baseline) 2427 (setq stop t)) 2428 ((looking-at-p markdown-regex-list) 2429 (setq stop nil)) 2430 (t (setq stop t))))))) 2431 2432 (defun markdown-update-list-levels (marker indent levels) 2433 "Update list levels given list MARKER, block INDENT, and current LEVELS. 2434 Here, MARKER is a string representing the type of list, INDENT is an integer 2435 giving the indentation, in spaces, of the current block, and LEVELS is a 2436 list of the indentation levels of parent list items. When LEVELS is nil, 2437 it means we are at baseline (not inside of a nested list)." 2438 (cond 2439 ;; New list item at baseline. 2440 ((and marker (null levels)) 2441 (setq levels (list indent))) 2442 ;; List item with greater indentation (four or more spaces). 2443 ;; Increase list level. 2444 ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) 2445 (setq levels (cons indent levels))) 2446 ;; List item with greater or equal indentation (less than four spaces). 2447 ;; Do not increase list level. 2448 ((and marker (>= indent (car levels))) 2449 levels) 2450 ;; Lesser indentation level. 2451 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser 2452 ;; indentation could move back more than one list level). Note 2453 ;; that this block need not be the beginning of list item. 2454 ((< indent (car levels)) 2455 (while (and (> (length levels) 1) 2456 (< indent (+ (cadr levels) markdown-list-indent-width))) 2457 (setq levels (cdr levels))) 2458 levels) 2459 ;; Otherwise, do nothing. 2460 (t levels))) 2461 2462 (defun markdown-calculate-list-levels () 2463 "Calculate list levels at point. 2464 Return a list of the form (n1 n2 n3 ...) where n1 is the 2465 indentation of the deepest nested list item in the branch of 2466 the list at the point, n2 is the indentation of the parent 2467 list item, and so on. The depth of the list item is therefore 2468 the length of the returned list. If the point is not at or 2469 immediately after a list item, return nil." 2470 (save-excursion 2471 (let ((first (point)) levels indent pre-regexp) 2472 ;; Find a baseline point with zero list indentation 2473 (markdown-search-backward-baseline) 2474 ;; Search for all list items between baseline and LOC 2475 (while (and (< (point) first) 2476 (re-search-forward markdown-regex-list first t)) 2477 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) 2478 (beginning-of-line) 2479 (cond 2480 ;; Make sure this is not a header or hr 2481 ((markdown-new-baseline) (setq levels nil)) 2482 ;; Make sure this is not a line from a pre block 2483 ((looking-at-p pre-regexp)) 2484 ;; If not, then update levels 2485 (t 2486 (setq indent (current-indentation)) 2487 (setq levels (markdown-update-list-levels (match-string 2) 2488 indent levels)))) 2489 (end-of-line)) 2490 levels))) 2491 2492 (defun markdown-prev-list-item (level) 2493 "Search backward from point for a list item with indentation LEVEL. 2494 Set point to the beginning of the item, and return point, or nil 2495 upon failure." 2496 (let (bounds indent prev) 2497 (setq prev (point)) 2498 (forward-line -1) 2499 (setq indent (current-indentation)) 2500 (while 2501 (cond 2502 ;; List item 2503 ((and (looking-at-p markdown-regex-list) 2504 (setq bounds (markdown-cur-list-item-bounds))) 2505 (cond 2506 ;; Stop and return point at item of equal indentation 2507 ((= (nth 3 bounds) level) 2508 (setq prev (point)) 2509 nil) 2510 ;; Stop and return nil at item with lesser indentation 2511 ((< (nth 3 bounds) level) 2512 (setq prev nil) 2513 nil) 2514 ;; Stop at beginning of buffer 2515 ((bobp) (setq prev nil)) 2516 ;; Continue at item with greater indentation 2517 ((> (nth 3 bounds) level) t))) 2518 ;; Stop at beginning of buffer 2519 ((bobp) (setq prev nil)) 2520 ;; Continue if current line is blank 2521 ((markdown-cur-line-blank-p) t) 2522 ;; Continue while indentation is the same or greater 2523 ((>= indent level) t) 2524 ;; Stop if current indentation is less than list item 2525 ;; and the next is blank 2526 ((and (< indent level) 2527 (markdown-next-line-blank-p)) 2528 (setq prev nil)) 2529 ;; Stop at a header 2530 ((looking-at-p markdown-regex-header) (setq prev nil)) 2531 ;; Stop at a horizontal rule 2532 ((looking-at-p markdown-regex-hr) (setq prev nil)) 2533 ;; Otherwise, continue. 2534 (t t)) 2535 (forward-line -1) 2536 (setq indent (current-indentation))) 2537 prev)) 2538 2539 (defun markdown-next-list-item (level) 2540 "Search forward from point for the next list item with indentation LEVEL. 2541 Set point to the beginning of the item, and return point, or nil 2542 upon failure." 2543 (let (bounds indent next) 2544 (setq next (point)) 2545 (if (looking-at markdown-regex-header-setext) 2546 (goto-char (match-end 0))) 2547 (forward-line) 2548 (setq indent (current-indentation)) 2549 (while 2550 (cond 2551 ;; Stop at end of the buffer. 2552 ((eobp) nil) 2553 ;; Continue if the current line is blank 2554 ((markdown-cur-line-blank-p) t) 2555 ;; List item 2556 ((and (looking-at-p markdown-regex-list) 2557 (setq bounds (markdown-cur-list-item-bounds))) 2558 (cond 2559 ;; Continue at item with greater indentation 2560 ((> (nth 3 bounds) level) t) 2561 ;; Stop and return point at item of equal indentation 2562 ((= (nth 3 bounds) level) 2563 (setq next (point)) 2564 nil) 2565 ;; Stop and return nil at item with lesser indentation 2566 ((< (nth 3 bounds) level) 2567 (setq next nil) 2568 nil))) 2569 ;; Continue while indentation is the same or greater 2570 ((>= indent level) t) 2571 ;; Stop if current indentation is less than list item 2572 ;; and the previous line was blank. 2573 ((and (< indent level) 2574 (markdown-prev-line-blank-p)) 2575 (setq next nil)) 2576 ;; Stop at a header 2577 ((looking-at-p markdown-regex-header) (setq next nil)) 2578 ;; Stop at a horizontal rule 2579 ((looking-at-p markdown-regex-hr) (setq next nil)) 2580 ;; Otherwise, continue. 2581 (t t)) 2582 (forward-line) 2583 (setq indent (current-indentation))) 2584 next)) 2585 2586 (defun markdown-cur-list-item-end (level) 2587 "Move to end of list item with pre-marker indentation LEVEL. 2588 Return the point at the end when a list item was found at the 2589 original point. If the point is not in a list item, do nothing." 2590 (let (indent) 2591 (forward-line) 2592 (setq indent (current-indentation)) 2593 (while 2594 (cond 2595 ;; Stop at end of the buffer. 2596 ((eobp) nil) 2597 ;; Continue while indentation is the same or greater 2598 ((>= indent level) t) 2599 ;; Continue if the current line is blank 2600 ((looking-at markdown-regex-blank-line) t) 2601 ;; Stop if current indentation is less than list item 2602 ;; and the previous line was blank. 2603 ((and (< indent level) 2604 (markdown-prev-line-blank)) 2605 nil) 2606 ;; Stop at a new list items of the same or lesser 2607 ;; indentation, headings, and horizontal rules. 2608 ((looking-at (concat "\\(?:" markdown-regex-list 2609 "\\|" markdown-regex-header 2610 "\\|" markdown-regex-hr "\\)")) 2611 nil) 2612 ;; Otherwise, continue. 2613 (t t)) 2614 (forward-line) 2615 (setq indent (current-indentation))) 2616 ;; Don't skip over whitespace for empty list items (marker and 2617 ;; whitespace only), just move to end of whitespace. 2618 (if (save-excursion 2619 (beginning-of-line) 2620 (looking-at (concat markdown-regex-list "[ \t]*$"))) 2621 (goto-char (match-end 3)) 2622 (skip-chars-backward " \t\n")) 2623 (end-of-line) 2624 (point))) 2625 2626 (defun markdown-cur-list-item-bounds () 2627 "Return bounds for list item at point. 2628 Return a list of the following form: 2629 2630 (begin end indent nonlist-indent marker checkbox match) 2631 2632 The named components are: 2633 2634 - begin: Position of beginning of list item, including leading indentation. 2635 - end: Position of the end of the list item, including list item text. 2636 - indent: Number of characters of indentation before list marker (an integer). 2637 - nonlist-indent: Number characters of indentation, list 2638 marker, and whitespace following list marker (an integer). 2639 - marker: String containing the list marker and following whitespace 2640 (e.g., \"- \" or \"* \"). 2641 - checkbox: String containing the GFM checkbox portion, if any, 2642 including any trailing whitespace before the text 2643 begins (e.g., \"[x] \"). 2644 - match: match data for markdown-regex-list 2645 2646 As an example, for the following unordered list item 2647 2648 - item 2649 2650 the returned list would be 2651 2652 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) 2653 2654 If the point is not inside a list item, return nil." 2655 (car (get-text-property (line-beginning-position) 'markdown-list-item))) 2656 2657 (defun markdown-list-item-at-point-p () 2658 "Return t if there is a list item at the point and nil otherwise." 2659 (save-match-data (markdown-cur-list-item-bounds))) 2660 2661 (defun markdown-prev-list-item-bounds () 2662 "Return bounds of previous item in the same list of any level. 2663 The return value has the same form as that of 2664 `markdown-cur-list-item-bounds'." 2665 (save-excursion 2666 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2667 (beginning-of-list (save-excursion (markdown-beginning-of-list))) 2668 stop) 2669 (when cur-bounds 2670 (goto-char (nth 0 cur-bounds)) 2671 (while (and (not stop) (not (bobp)) 2672 (re-search-backward markdown-regex-list 2673 beginning-of-list t)) 2674 (unless (or (looking-at markdown-regex-hr) 2675 (markdown-code-block-at-point-p)) 2676 (setq stop (point)))) 2677 (markdown-cur-list-item-bounds))))) 2678 2679 (defun markdown-next-list-item-bounds () 2680 "Return bounds of next item in the same list of any level. 2681 The return value has the same form as that of 2682 `markdown-cur-list-item-bounds'." 2683 (save-excursion 2684 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2685 (end-of-list (save-excursion (markdown-end-of-list))) 2686 stop) 2687 (when cur-bounds 2688 (goto-char (nth 0 cur-bounds)) 2689 (end-of-line) 2690 (while (and (not stop) (not (eobp)) 2691 (re-search-forward markdown-regex-list 2692 end-of-list t)) 2693 (unless (or (looking-at markdown-regex-hr) 2694 (markdown-code-block-at-point-p)) 2695 (setq stop (point)))) 2696 (when stop 2697 (markdown-cur-list-item-bounds)))))) 2698 2699 (defun markdown-beginning-of-list () 2700 "Move point to beginning of list at point, if any." 2701 (interactive) 2702 (let ((orig-point (point)) 2703 (list-begin (save-excursion 2704 (markdown-search-backward-baseline) 2705 ;; Stop at next list item, regardless of the indentation. 2706 (markdown-next-list-item (point-max)) 2707 (when (looking-at markdown-regex-list) 2708 (point))))) 2709 (when (and list-begin (<= list-begin orig-point)) 2710 (goto-char list-begin)))) 2711 2712 (defun markdown-end-of-list () 2713 "Move point to end of list at point, if any." 2714 (interactive) 2715 (let ((start (point)) 2716 (end (save-excursion 2717 (when (markdown-beginning-of-list) 2718 ;; Items can't have nonlist-indent <= 1, so this 2719 ;; moves past all list items. 2720 (markdown-next-list-item 1) 2721 (skip-syntax-backward "-") 2722 (unless (eobp) (forward-char 1)) 2723 (point))))) 2724 (when (and end (>= end start)) 2725 (goto-char end)))) 2726 2727 (defun markdown-up-list () 2728 "Move point to beginning of parent list item." 2729 (interactive) 2730 (let ((cur-bounds (markdown-cur-list-item-bounds))) 2731 (when cur-bounds 2732 (markdown-prev-list-item (1- (nth 3 cur-bounds))) 2733 (let ((up-bounds (markdown-cur-list-item-bounds))) 2734 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) 2735 (point)))))) 2736 2737 (defun markdown-bounds-of-thing-at-point (thing) 2738 "Call `bounds-of-thing-at-point' for THING with slight modifications. 2739 Does not include trailing newlines when THING is \\='line. Handles the 2740 end of buffer case by setting both endpoints equal to the value of 2741 `point-max', since an empty region will trigger empty markup insertion. 2742 Return bounds of form (beg . end) if THING is found, or nil otherwise." 2743 (let* ((bounds (bounds-of-thing-at-point thing)) 2744 (a (car bounds)) 2745 (b (cdr bounds))) 2746 (when bounds 2747 (when (eq thing 'line) 2748 (cond ((and (eobp) (markdown-cur-line-blank-p)) 2749 (setq a b)) 2750 ((char-equal (char-before b) ?\^J) 2751 (setq b (1- b))))) 2752 (cons a b)))) 2753 2754 (defun markdown-reference-definition (reference) 2755 "Find out whether Markdown REFERENCE is defined. 2756 REFERENCE should not include the square brackets. 2757 When REFERENCE is defined, return a list of the form (text start end) 2758 containing the definition text itself followed by the start and end 2759 locations of the text. Otherwise, return nil. 2760 Leave match data for `markdown-regex-reference-definition' 2761 intact additional processing." 2762 (let ((reference (downcase reference))) 2763 (save-excursion 2764 (goto-char (point-min)) 2765 (catch 'found 2766 (while (re-search-forward markdown-regex-reference-definition nil t) 2767 (when (string= reference (downcase (match-string-no-properties 2))) 2768 (throw 'found 2769 (list (match-string-no-properties 5) 2770 (match-beginning 5) (match-end 5))))))))) 2771 2772 (defun markdown-get-defined-references () 2773 "Return all defined reference labels and their line numbers. 2774 They does not include square brackets)." 2775 (save-excursion 2776 (goto-char (point-min)) 2777 (let (refs) 2778 (while (re-search-forward markdown-regex-reference-definition nil t) 2779 (let ((target (match-string-no-properties 2))) 2780 (cl-pushnew 2781 (cons (downcase target) 2782 (markdown-line-number-at-pos (match-beginning 2))) 2783 refs :test #'equal :key #'car))) 2784 (reverse refs)))) 2785 2786 (defun markdown-get-used-uris () 2787 "Return a list of all used URIs in the buffer." 2788 (save-excursion 2789 (goto-char (point-min)) 2790 (let (uris) 2791 (while (re-search-forward 2792 (concat "\\(?:" markdown-regex-link-inline 2793 "\\|" markdown-regex-angle-uri 2794 "\\|" markdown-regex-uri 2795 "\\|" markdown-regex-email 2796 "\\)") 2797 nil t) 2798 (unless (or (markdown-inline-code-at-point-p) 2799 (markdown-code-block-at-point-p)) 2800 (cl-pushnew (or (match-string-no-properties 6) 2801 (match-string-no-properties 10) 2802 (match-string-no-properties 12) 2803 (match-string-no-properties 13)) 2804 uris :test #'equal))) 2805 (reverse uris)))) 2806 2807 (defun markdown-inline-code-at-pos (pos) 2808 "Return non-nil if there is an inline code fragment at POS. 2809 Return nil otherwise. Set match data according to 2810 `markdown-match-code' upon success. 2811 This function searches the block for a code fragment that 2812 contains the point using `markdown-match-code'. We do this 2813 because `thing-at-point-looking-at' does not work reliably with 2814 `markdown-regex-code'. 2815 2816 The match data is set as follows: 2817 Group 1 matches the opening backquotes. 2818 Group 2 matches the code fragment itself, without backquotes. 2819 Group 3 matches the closing backquotes." 2820 (save-excursion 2821 (goto-char pos) 2822 (let ((old-point (point)) 2823 (end-of-block (progn (markdown-end-of-text-block) (point))) 2824 found) 2825 (markdown-beginning-of-text-block) 2826 (while (and (markdown-match-code end-of-block) 2827 (setq found t) 2828 (< (match-end 0) old-point))) 2829 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) 2830 (and found ; matched something 2831 (<= (match-beginning match-group) old-point) ; match contains old-point 2832 (> (match-end 0) old-point)))))) 2833 2834 (defun markdown-inline-code-at-pos-p (pos) 2835 "Return non-nil if there is an inline code fragment at POS. 2836 Like `markdown-inline-code-at-pos`, but preserves match data." 2837 (save-match-data (markdown-inline-code-at-pos pos))) 2838 2839 (defun markdown-inline-code-at-point () 2840 "Return non-nil if the point is at an inline code fragment. 2841 See `markdown-inline-code-at-pos' for details." 2842 (markdown-inline-code-at-pos (point))) 2843 2844 (defun markdown-inline-code-at-point-p (&optional pos) 2845 "Return non-nil if there is inline code at the POS. 2846 This is a predicate function counterpart to 2847 `markdown-inline-code-at-point' which does not modify the match 2848 data. See `markdown-code-block-at-point-p' for code blocks." 2849 (save-match-data (markdown-inline-code-at-pos (or pos (point))))) 2850 2851 (defun markdown-code-block-at-pos (pos) 2852 "Return match data list if there is a code block at POS. 2853 Uses text properties at the beginning of the line position. 2854 This includes pre blocks, tilde-fenced code blocks, and GFM 2855 quoted code blocks. Return nil otherwise." 2856 (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) 2857 (or (get-text-property bol 'markdown-pre) 2858 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) 2859 (second (cl-second bounds))) 2860 (if second 2861 ;; chunks are right open 2862 (when (< pos second) 2863 bounds) 2864 bounds))))) 2865 2866 ;; Function was renamed to emphasize that it does not modify match-data. 2867 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) 2868 2869 (defun markdown-code-block-at-point-p (&optional pos) 2870 "Return non-nil if there is a code block at the POS. 2871 This includes pre blocks, tilde-fenced code blocks, and GFM 2872 quoted code blocks. This function does not modify the match 2873 data. See `markdown-inline-code-at-point-p' for inline code." 2874 (save-match-data (markdown-code-block-at-pos (or pos (point))))) 2875 2876 (defun markdown-heading-at-point (&optional pos) 2877 "Return non-nil if there is a heading at the POS. 2878 Set match data for `markdown-regex-header'." 2879 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) 2880 (when match-data 2881 (set-match-data match-data) 2882 t))) 2883 2884 (defun markdown-pipe-at-bol-p () 2885 "Return non-nil if the line begins with a pipe symbol. 2886 This may be useful for tables and Pandoc's line_blocks extension." 2887 (char-equal (char-after (line-beginning-position)) ?|)) 2888 2889 2890 ;;; Markdown Font Lock Matching Functions ===================================== 2891 2892 (defun markdown-range-property-any (begin end prop prop-values) 2893 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. 2894 Also returns t if PROP is a list containing one of the PROP-VALUES. 2895 Return nil otherwise." 2896 (let (props) 2897 (catch 'found 2898 (dolist (loc (number-sequence begin end)) 2899 (when (setq props (get-text-property loc prop)) 2900 (cond ((listp props) 2901 ;; props is a list, check for membership 2902 (dolist (val prop-values) 2903 (when (memq val props) (throw 'found loc)))) 2904 (t 2905 ;; props is a scalar, check for equality 2906 (dolist (val prop-values) 2907 (when (eq val props) (throw 'found loc)))))))))) 2908 2909 (defun markdown-range-properties-exist (begin end props) 2910 (cl-loop 2911 for loc in (number-sequence begin end) 2912 with result = nil 2913 while (not 2914 (setq result 2915 (cl-some (lambda (prop) (get-text-property loc prop)) props))) 2916 finally return result)) 2917 2918 (defun markdown-match-inline-generic (regex last &optional faceless) 2919 "Match inline REGEX from the point to LAST. 2920 When FACELESS is non-nil, do not return matches where faces have been applied." 2921 (when (re-search-forward regex last t) 2922 (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) 2923 (face (and faceless (text-property-not-all 2924 (match-beginning 0) (match-end 0) 'face nil)))) 2925 (cond 2926 ;; In code block: move past it and recursively search again 2927 (bounds 2928 (when (< (goto-char (cl-second bounds)) last) 2929 (markdown-match-inline-generic regex last faceless))) 2930 ;; When faces are found in the match range, skip over the match and 2931 ;; recursively search again. 2932 (face 2933 (when (< (goto-char (match-end 0)) last) 2934 (markdown-match-inline-generic regex last faceless))) 2935 ;; Keep match data and return t when in bounds. 2936 (t 2937 (<= (match-end 0) last)))))) 2938 2939 (defun markdown-match-code (last) 2940 "Match inline code fragments from point to LAST." 2941 (unless (bobp) 2942 (backward-char 1)) 2943 (when (markdown-search-until-condition 2944 (lambda () 2945 (and 2946 ;; Advance point in case of failure, but without exceeding last. 2947 (goto-char (min (1+ (match-beginning 1)) last)) 2948 (not (markdown-in-comment-p (match-beginning 1))) 2949 (not (markdown-in-comment-p (match-end 1))) 2950 (not (markdown-code-block-at-pos (match-beginning 1))))) 2951 markdown-regex-code last t) 2952 (set-match-data (list (match-beginning 1) (match-end 1) 2953 (match-beginning 2) (match-end 2) 2954 (match-beginning 3) (match-end 3) 2955 (match-beginning 4) (match-end 4))) 2956 (goto-char (min (1+ (match-end 0)) last (point-max))) 2957 t)) 2958 2959 (defun markdown--gfm-markup-underscore-p (begin end) 2960 (let ((is-underscore (eql (char-after begin) ?_))) 2961 (if (not is-underscore) 2962 t 2963 (save-excursion 2964 (save-match-data 2965 (goto-char begin) 2966 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) 2967 (progn 2968 (goto-char end) 2969 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) 2970 2971 (defun markdown-match-bold (last) 2972 "Match inline bold from the point to LAST." 2973 (when (markdown-match-inline-generic markdown-regex-bold last) 2974 (let ((is-gfm (derived-mode-p 'gfm-mode)) 2975 (begin (match-beginning 2)) 2976 (end (match-end 2))) 2977 (if (or (markdown-inline-code-at-pos-p begin) 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 (when (< (point) last) 2989 (markdown-match-bold last))) 2990 (set-match-data (list (match-beginning 2) (match-end 2) 2991 (match-beginning 3) (match-end 3) 2992 (match-beginning 4) (match-end 4) 2993 (match-beginning 5) (match-end 5))) 2994 t)))) 2995 2996 (defun markdown-match-italic (last) 2997 "Match inline italics from the point to LAST." 2998 (let* ((is-gfm (derived-mode-p 'gfm-mode)) 2999 (regex (if is-gfm 3000 markdown-regex-gfm-italic 3001 markdown-regex-italic))) 3002 (when (and (markdown-match-inline-generic regex last) 3003 (not (markdown--face-p 3004 (match-beginning 1) 3005 '(markdown-html-attr-name-face markdown-html-attr-value-face)))) 3006 (let ((begin (match-beginning 1)) 3007 (end (match-end 1)) 3008 (close-end (match-end 4))) 3009 (if (or (eql (char-before begin) (char-after begin)) 3010 (markdown-inline-code-at-pos-p begin) 3011 (markdown-inline-code-at-pos-p (1- end)) 3012 (markdown-in-comment-p) 3013 (markdown-range-property-any 3014 begin begin 'face '(markdown-url-face 3015 markdown-plain-url-face 3016 markdown-markup-face)) 3017 (markdown-range-property-any 3018 begin end 'face '(markdown-bold-face 3019 markdown-list-face 3020 markdown-hr-face 3021 markdown-math-face)) 3022 (and is-gfm 3023 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case 3024 (not (markdown--gfm-markup-underscore-p begin close-end))))) 3025 (progn (goto-char (min (1+ begin) last)) 3026 (when (< (point) last) 3027 (markdown-match-italic last))) 3028 (set-match-data (list (match-beginning 1) (match-end 1) 3029 (match-beginning 2) (match-end 2) 3030 (match-beginning 3) (match-end 3) 3031 (match-beginning 4) (match-end 4))) 3032 t))))) 3033 3034 (defun markdown--match-highlighting (last) 3035 (when markdown-enable-highlighting-syntax 3036 (re-search-forward markdown-regex-highlighting last t))) 3037 3038 (defun markdown-match-escape (last) 3039 "Match escape characters (backslashes) from point to LAST. 3040 Backlashes only count as escape characters outside of literal 3041 regions (e.g. code blocks). See `markdown-literal-faces'." 3042 (catch 'found 3043 (while (search-forward-regexp markdown-regex-escape last t) 3044 (let* ((face (get-text-property (match-beginning 1) 'face)) 3045 (face-list (if (listp face) face (list face)))) 3046 ;; Ignore any backslashes with a literal face. 3047 (unless (cl-intersection face-list markdown-literal-faces) 3048 (throw 'found t)))))) 3049 3050 (defun markdown-match-math-generic (regex last) 3051 "Match REGEX from point to LAST. 3052 REGEX is either `markdown-regex-math-inline-single' for matching 3053 $..$ or `markdown-regex-math-inline-double' for matching $$..$$." 3054 (when (markdown-match-inline-generic regex last) 3055 (let ((begin (match-beginning 1)) (end (match-end 1))) 3056 (prog1 3057 (if (or (markdown-range-property-any 3058 begin end 'face 3059 '(markdown-inline-code-face markdown-bold-face)) 3060 (markdown-range-properties-exist 3061 begin end 3062 (markdown-get-fenced-block-middle-properties))) 3063 (markdown-match-math-generic regex last) 3064 t) 3065 (goto-char (1+ (match-end 0))))))) 3066 3067 (defun markdown-match-list-items (last) 3068 "Match list items from point to LAST." 3069 (let* ((first (point)) 3070 (pos first) 3071 (prop 'markdown-list-item) 3072 (bounds (car (get-text-property pos prop)))) 3073 (while 3074 (and (or (null (setq bounds (car (get-text-property pos prop)))) 3075 (< (cl-first bounds) pos)) 3076 (< (point) last) 3077 (setq pos (next-single-property-change pos prop nil last)) 3078 (goto-char pos))) 3079 (when bounds 3080 (set-match-data (cl-seventh bounds)) 3081 ;; Step at least one character beyond point. Otherwise 3082 ;; `font-lock-fontify-keywords-region' infloops. 3083 (goto-char (min (1+ (max (line-end-position) first)) 3084 (point-max))) 3085 t))) 3086 3087 (defun markdown-match-math-single (last) 3088 "Match single quoted $..$ math from point to LAST." 3089 (when markdown-enable-math 3090 (when (and (char-equal (char-after) ?$) 3091 (not (bolp)) 3092 (not (char-equal (char-before) ?\\)) 3093 (not (char-equal (char-before) ?$))) 3094 (forward-char -1)) 3095 (markdown-match-math-generic markdown-regex-math-inline-single last))) 3096 3097 (defun markdown-match-math-double (last) 3098 "Match double quoted $$..$$ math from point to LAST." 3099 (when markdown-enable-math 3100 (when (and (< (1+ (point)) (point-max)) 3101 (char-equal (char-after) ?$) 3102 (char-equal (char-after (1+ (point))) ?$) 3103 (not (bolp)) 3104 (not (char-equal (char-before) ?\\)) 3105 (not (char-equal (char-before) ?$))) 3106 (forward-char -1)) 3107 (markdown-match-math-generic markdown-regex-math-inline-double last))) 3108 3109 (defun markdown-match-math-display (last) 3110 "Match bracketed display math \[..\] and \\[..\\] from point to LAST." 3111 (when markdown-enable-math 3112 (markdown-match-math-generic markdown-regex-math-display last))) 3113 3114 (defun markdown-match-propertized-text (property last) 3115 "Match text with PROPERTY from point to LAST. 3116 Restore match data previously stored in PROPERTY." 3117 (let ((saved (get-text-property (point) property)) 3118 pos) 3119 (unless saved 3120 (setq pos (next-single-property-change (point) property nil last)) 3121 (unless (= pos last) 3122 (setq saved (get-text-property pos property)))) 3123 (when saved 3124 (set-match-data saved) 3125 ;; Step at least one character beyond point. Otherwise 3126 ;; `font-lock-fontify-keywords-region' infloops. 3127 (goto-char (min (1+ (max (match-end 0) (point))) 3128 (point-max))) 3129 saved))) 3130 3131 (defun markdown-match-pre-blocks (last) 3132 "Match preformatted blocks from point to LAST. 3133 Use data stored in \\='markdown-pre text property during syntax 3134 analysis." 3135 (markdown-match-propertized-text 'markdown-pre last)) 3136 3137 (defun markdown-match-gfm-code-blocks (last) 3138 "Match GFM quoted code blocks from point to LAST. 3139 Use data stored in \\='markdown-gfm-code text property during syntax 3140 analysis." 3141 (markdown-match-propertized-text 'markdown-gfm-code last)) 3142 3143 (defun markdown-match-gfm-open-code-blocks (last) 3144 (markdown-match-propertized-text 'markdown-gfm-block-begin last)) 3145 3146 (defun markdown-match-gfm-close-code-blocks (last) 3147 (markdown-match-propertized-text 'markdown-gfm-block-end last)) 3148 3149 (defun markdown-match-fenced-code-blocks (last) 3150 "Match fenced code blocks from the point to LAST." 3151 (markdown-match-propertized-text 'markdown-fenced-code last)) 3152 3153 (defun markdown-match-fenced-start-code-block (last) 3154 (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) 3155 3156 (defun markdown-match-fenced-end-code-block (last) 3157 (markdown-match-propertized-text 'markdown-tilde-fence-end last)) 3158 3159 (defun markdown-match-blockquotes (last) 3160 "Match blockquotes from point to LAST. 3161 Use data stored in \\='markdown-blockquote text property during syntax 3162 analysis." 3163 (markdown-match-propertized-text 'markdown-blockquote last)) 3164 3165 (defun markdown-match-hr (last) 3166 "Match horizontal rules comments from the point to LAST." 3167 (markdown-match-propertized-text 'markdown-hr last)) 3168 3169 (defun markdown-match-comments (last) 3170 "Match HTML comments from the point to LAST." 3171 (when (and (skip-syntax-forward "^<" last)) 3172 (let ((beg (point))) 3173 (when (and (skip-syntax-forward "^>" last) (< (point) last)) 3174 (forward-char) 3175 (set-match-data (list beg (point))) 3176 t)))) 3177 3178 (defun markdown-match-generic-links (last ref) 3179 "Match inline links from point to LAST. 3180 When REF is non-nil, match reference links instead of standard 3181 links with URLs. 3182 This function should only be used during font-lock, as it 3183 determines syntax based on the presence of faces for previously 3184 processed elements." 3185 ;; Search for the next potential link (not in a code block). 3186 (let ((prohibited-faces '(markdown-pre-face 3187 markdown-code-face 3188 markdown-inline-code-face 3189 markdown-comment-face)) 3190 found) 3191 (while 3192 (and (not found) (< (point) last) 3193 (progn 3194 ;; Clear match data to test for a match after functions returns. 3195 (set-match-data nil) 3196 ;; Preliminary regular expression search so we can return 3197 ;; quickly upon failure. This doesn't handle malformed links 3198 ;; or nested square brackets well, so if it passes we back up 3199 ;; continue with a more precise search. 3200 (re-search-forward 3201 (if ref 3202 markdown-regex-link-reference 3203 markdown-regex-link-inline) 3204 last 'limit))) 3205 ;; Keep searching if this is in a code block, inline code, or a 3206 ;; comment, or if it is include syntax. The link text portion 3207 ;; (group 3) may contain inline code or comments, but the 3208 ;; markup, URL, and title should not be part of such elements. 3209 (if (or (markdown-range-property-any 3210 (match-beginning 0) (match-end 2) 'face prohibited-faces) 3211 (markdown-range-property-any 3212 (match-beginning 4) (match-end 0) 'face prohibited-faces) 3213 (and (char-equal (char-after (line-beginning-position)) ?<) 3214 (char-equal (char-after (1+ (line-beginning-position))) ?<))) 3215 (set-match-data nil) 3216 (setq found t)))) 3217 ;; Match opening exclamation point (optional) and left bracket. 3218 (when (match-beginning 2) 3219 (let* ((bang (match-beginning 1)) 3220 (first-begin (match-beginning 2)) 3221 ;; Find end of block to prevent matching across blocks. 3222 (end-of-block (save-excursion 3223 (progn 3224 (goto-char (match-beginning 2)) 3225 (markdown-end-of-text-block) 3226 (point)))) 3227 ;; Move over balanced expressions to closing right bracket. 3228 ;; Catch unbalanced expression errors and return nil. 3229 (first-end (condition-case nil 3230 (and (goto-char first-begin) 3231 (scan-sexps (point) 1)) 3232 (error nil))) 3233 ;; Continue with point at CONT-POINT upon failure. 3234 (cont-point (min (1+ first-begin) last)) 3235 second-begin second-end url-begin url-end 3236 title-begin title-end) 3237 ;; When bracket found, in range, and followed by a left paren/bracket... 3238 (when (and first-end (< first-end end-of-block) (goto-char first-end) 3239 (char-equal (char-after (point)) (if ref ?\[ ?\())) 3240 ;; Scan across balanced expressions for closing parenthesis/bracket. 3241 (setq second-begin (point) 3242 second-end (condition-case nil 3243 (scan-sexps (point) 1) 3244 (error nil))) 3245 ;; Check that closing parenthesis/bracket is in range. 3246 (if (and second-end (<= second-end end-of-block) (<= second-end last)) 3247 (progn 3248 ;; Search for (optional) title inside closing parenthesis 3249 (when (and (not ref) (search-forward "\"" second-end t)) 3250 (setq title-begin (1- (point)) 3251 title-end (and (goto-char second-end) 3252 (search-backward "\"" (1+ title-begin) t)) 3253 title-end (and title-end (1+ title-end)))) 3254 ;; Store URL/reference range 3255 (setq url-begin (1+ second-begin) 3256 url-end (1- (or title-begin second-end))) 3257 ;; Set match data, move point beyond link, and return 3258 (set-match-data 3259 (list (or bang first-begin) second-end ; 0 - all 3260 bang (and bang (1+ bang)) ; 1 - bang 3261 first-begin (1+ first-begin) ; 2 - markup 3262 (1+ first-begin) (1- first-end) ; 3 - link text 3263 (1- first-end) first-end ; 4 - markup 3264 second-begin (1+ second-begin) ; 5 - markup 3265 url-begin url-end ; 6 - url/reference 3266 title-begin title-end ; 7 - title 3267 (1- second-end) second-end)) ; 8 - markup 3268 ;; Nullify cont-point and leave point at end and 3269 (setq cont-point nil) 3270 (goto-char second-end)) 3271 ;; If no closing parenthesis in range, update continuation point 3272 (setq cont-point (min end-of-block second-begin)))) 3273 (cond 3274 ;; On failure, continue searching at cont-point 3275 ((and cont-point (< cont-point last)) 3276 (goto-char cont-point) 3277 (markdown-match-generic-links last ref)) 3278 ;; No more text, return nil 3279 ((and cont-point (= cont-point last)) 3280 nil) 3281 ;; Return t if a match occurred 3282 (t t))))) 3283 3284 (defun markdown-match-angle-uris (last) 3285 "Match angle bracket URIs from point to LAST." 3286 (when (markdown-match-inline-generic markdown-regex-angle-uri last) 3287 (goto-char (1+ (match-end 0))))) 3288 3289 (defun markdown-match-plain-uris (last) 3290 "Match plain URIs from point to LAST." 3291 (when (markdown-match-inline-generic markdown-regex-uri last t) 3292 (goto-char (1+ (match-end 0))))) 3293 3294 (defvar markdown-conditional-search-function #'re-search-forward 3295 "Conditional search function used in `markdown-search-until-condition'. 3296 Made into a variable to allow for dynamic let-binding.") 3297 3298 (defun markdown-search-until-condition (condition &rest args) 3299 (let (ret) 3300 (while (and (not ret) (apply markdown-conditional-search-function args)) 3301 (setq ret (funcall condition))) 3302 ret)) 3303 3304 (defun markdown-metadata-line-p (pos regexp) 3305 (save-excursion 3306 (or (= (line-number-at-pos pos) 1) 3307 (progn 3308 (forward-line -1) 3309 ;; skip multi-line metadata 3310 (while (and (looking-at-p "^\\s-+[[:alpha:]]") 3311 (> (line-number-at-pos (point)) 1)) 3312 (forward-line -1)) 3313 (looking-at-p regexp))))) 3314 3315 (defun markdown-match-generic-metadata (regexp last) 3316 "Match metadata declarations specified by REGEXP from point to LAST. 3317 These declarations must appear inside a metadata block that begins at 3318 the beginning of the buffer and ends with a blank line (or the end of 3319 the buffer)." 3320 (let* ((first (point)) 3321 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") 3322 (block-begin (goto-char 1)) 3323 (block-end (re-search-forward end-re nil t))) 3324 (if (and block-end (> first block-end)) 3325 ;; Don't match declarations if there is no metadata block or if 3326 ;; the point is beyond the block. Move point to point-max to 3327 ;; prevent additional searches and return return nil since nothing 3328 ;; was found. 3329 (progn (goto-char (point-max)) nil) 3330 ;; If a block was found that begins before LAST and ends after 3331 ;; point, search for declarations inside it. If the starting is 3332 ;; before the beginning of the block, start there. Otherwise, 3333 ;; move back to FIRST. 3334 (goto-char (if (< first block-begin) block-begin first)) 3335 (if (and (re-search-forward regexp (min last block-end) t) 3336 (markdown-metadata-line-p (point) regexp)) 3337 ;; If a metadata declaration is found, set match-data and return t. 3338 (let ((key-beginning (match-beginning 1)) 3339 (key-end (match-end 1)) 3340 (markup-begin (match-beginning 2)) 3341 (markup-end (match-end 2)) 3342 (value-beginning (match-beginning 3))) 3343 (set-match-data (list key-beginning (point) ; complete metadata 3344 key-beginning key-end ; key 3345 markup-begin markup-end ; markup 3346 value-beginning (point))) ; value 3347 t) 3348 ;; Otherwise, move the point to last and return nil 3349 (goto-char last) 3350 nil)))) 3351 3352 (defun markdown-match-declarative-metadata (last) 3353 "Match declarative metadata from the point to LAST." 3354 (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) 3355 3356 (defun markdown-match-pandoc-metadata (last) 3357 "Match Pandoc metadata from the point to LAST." 3358 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) 3359 3360 (defun markdown-match-yaml-metadata-begin (last) 3361 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) 3362 3363 (defun markdown-match-yaml-metadata-end (last) 3364 (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) 3365 3366 (defun markdown-match-yaml-metadata-key (last) 3367 (markdown-match-propertized-text 'markdown-metadata-key last)) 3368 3369 (defun markdown-match-wiki-link (last) 3370 "Match wiki links from point to LAST." 3371 (when (and markdown-enable-wiki-links 3372 (not markdown-wiki-link-fontify-missing) 3373 (markdown-match-inline-generic markdown-regex-wiki-link last)) 3374 (let ((begin (match-beginning 1)) (end (match-end 1))) 3375 (if (or (markdown-in-comment-p begin) 3376 (markdown-in-comment-p end) 3377 (markdown-inline-code-at-pos-p begin) 3378 (markdown-inline-code-at-pos-p end) 3379 (markdown-code-block-at-pos begin)) 3380 (progn (goto-char (min (1+ begin) last)) 3381 (when (< (point) last) 3382 (markdown-match-wiki-link last))) 3383 (set-match-data (list begin end)) 3384 t)))) 3385 3386 (defun markdown-match-inline-attributes (last) 3387 "Match inline attributes from point to LAST." 3388 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. 3389 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes 3390 ;; against matched string. 3391 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) 3392 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) 3393 (markdown-match-inline-attributes last) 3394 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3395 (markdown-inline-code-at-pos-p (match-end 0)) 3396 (markdown-in-comment-p)) 3397 t)))) 3398 3399 (defun markdown-match-leanpub-sections (last) 3400 "Match Leanpub section markers from point to LAST." 3401 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) 3402 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3403 (markdown-inline-code-at-pos-p (match-end 0)) 3404 (markdown-in-comment-p)) 3405 t))) 3406 3407 (defun markdown-match-includes (last) 3408 "Match include statements from point to LAST. 3409 Sets match data for the following seven groups: 3410 Group 1: opening two angle brackets 3411 Group 2: opening title delimiter (optional) 3412 Group 3: title text (optional) 3413 Group 4: closing title delimiter (optional) 3414 Group 5: opening filename delimiter 3415 Group 6: filename 3416 Group 7: closing filename delimiter" 3417 (when (markdown-match-inline-generic markdown-regex-include last) 3418 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) 3419 (markdown-in-comment-p (match-end 0)) 3420 (markdown-code-block-at-pos (match-beginning 0)))))) 3421 (cond 3422 ;; Parentheses and maybe square brackets, but no curly braces: 3423 ;; match optional title in square brackets and file in parentheses. 3424 ((and valid (match-beginning 5) 3425 (not (match-beginning 8))) 3426 (set-match-data (list (match-beginning 1) (match-end 7) 3427 (match-beginning 1) (match-end 1) 3428 (match-beginning 2) (match-end 2) 3429 (match-beginning 3) (match-end 3) 3430 (match-beginning 4) (match-end 4) 3431 (match-beginning 5) (match-end 5) 3432 (match-beginning 6) (match-end 6) 3433 (match-beginning 7) (match-end 7)))) 3434 ;; Only square brackets present: match file in square brackets. 3435 ((and valid (match-beginning 2) 3436 (not (match-beginning 5)) 3437 (not (match-beginning 7))) 3438 (set-match-data (list (match-beginning 1) (match-end 4) 3439 (match-beginning 1) (match-end 1) 3440 nil nil 3441 nil nil 3442 nil nil 3443 (match-beginning 2) (match-end 2) 3444 (match-beginning 3) (match-end 3) 3445 (match-beginning 4) (match-end 4)))) 3446 ;; Only curly braces present: match file in curly braces. 3447 ((and valid (match-beginning 8) 3448 (not (match-beginning 2)) 3449 (not (match-beginning 5))) 3450 (set-match-data (list (match-beginning 1) (match-end 10) 3451 (match-beginning 1) (match-end 1) 3452 nil nil 3453 nil nil 3454 nil nil 3455 (match-beginning 8) (match-end 8) 3456 (match-beginning 9) (match-end 9) 3457 (match-beginning 10) (match-end 10)))) 3458 (t 3459 ;; Not a valid match, move to next line and search again. 3460 (forward-line) 3461 (when (< (point) last) 3462 (setq valid (markdown-match-includes last))))) 3463 valid))) 3464 3465 (defun markdown-match-html-tag (last) 3466 "Match HTML tags from point to LAST." 3467 (when (and markdown-enable-html 3468 (markdown-match-inline-generic markdown-regex-html-tag last t)) 3469 (set-match-data (list (match-beginning 0) (match-end 0) 3470 (match-beginning 1) (match-end 1) 3471 (match-beginning 2) (match-end 2) 3472 (match-beginning 9) (match-end 9))) 3473 t)) 3474 3475 3476 ;;; Markdown Font Fontification Functions ===================================== 3477 3478 (defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) 3479 3480 (defun markdown--first-displayable (seq) 3481 "Return the first displayable character or string in SEQ. 3482 SEQ may be an atom or a sequence." 3483 (let ((c (gethash seq markdown--first-displayable-cache t))) 3484 (if (not (eq c t)) 3485 c 3486 (puthash seq 3487 (let ((seq (if (listp seq) seq (list seq)))) 3488 (cond ((stringp (car seq)) 3489 (cl-find-if 3490 (lambda (str) 3491 (and (mapcar #'char-displayable-p (string-to-list str)))) 3492 seq)) 3493 ((characterp (car seq)) 3494 (cl-find-if #'char-displayable-p seq)))) 3495 markdown--first-displayable-cache)))) 3496 3497 (defun markdown--marginalize-string (level) 3498 "Generate atx markup string of given LEVEL for left margin." 3499 (let ((margin-left-space-count 3500 (- markdown-marginalize-headers-margin-width level))) 3501 (concat (make-string margin-left-space-count ? ) 3502 (make-string level ?#)))) 3503 3504 (defun markdown-marginalize-update-current () 3505 "Update the window configuration to create a left margin." 3506 (if window-system 3507 (let* ((header-delimiter-font-width 3508 (window-font-width nil 'markdown-header-delimiter-face)) 3509 (margin-pixel-width (* markdown-marginalize-headers-margin-width 3510 header-delimiter-font-width)) 3511 (margin-char-width (/ margin-pixel-width (default-font-width)))) 3512 (set-window-margins nil margin-char-width)) 3513 ;; As a fallback, simply set margin based on character count. 3514 (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) 3515 3516 (defun markdown-fontify-headings (last) 3517 "Add text properties to headings from point to LAST." 3518 (when (markdown-match-propertized-text 'markdown-heading last) 3519 (let* ((level (markdown-outline-level)) 3520 (heading-face 3521 (intern (format "markdown-header-face-%d" level))) 3522 (heading-props `(face ,heading-face)) 3523 (left-markup-props 3524 `(face markdown-header-delimiter-face 3525 ,@(cond 3526 (markdown-hide-markup 3527 `(display "")) 3528 (markdown-marginalize-headers 3529 `(display ((margin left-margin) 3530 ,(markdown--marginalize-string level))))))) 3531 (right-markup-props 3532 `(face markdown-header-delimiter-face 3533 ,@(when markdown-hide-markup `(display "")))) 3534 (rule-props `(face markdown-header-rule-face 3535 ,@(when markdown-hide-markup `(display ""))))) 3536 (if (match-end 1) 3537 ;; Setext heading 3538 (progn (add-text-properties 3539 (match-beginning 1) (match-end 1) heading-props) 3540 (if (= level 1) 3541 (add-text-properties 3542 (match-beginning 2) (match-end 2) rule-props) 3543 (add-text-properties 3544 (match-beginning 3) (match-end 3) rule-props))) 3545 ;; atx heading 3546 (let ((header-end 3547 (if markdown-fontify-whole-heading-line 3548 (min (point-max) (1+ (match-end 0))) 3549 (match-end 0)))) 3550 (add-text-properties 3551 (match-beginning 4) (match-end 4) left-markup-props) 3552 3553 ;; If closing tag is present 3554 (if (match-end 6) 3555 (progn 3556 (if markdown-hide-markup 3557 (progn 3558 (add-text-properties 3559 (match-beginning 5) header-end heading-props) 3560 (add-text-properties 3561 (match-beginning 6) (match-end 6) right-markup-props)) 3562 (add-text-properties 3563 (match-beginning 5) (match-end 5) heading-props) 3564 (add-text-properties 3565 (match-beginning 6) header-end right-markup-props))) 3566 ;; If closing tag is not present 3567 (add-text-properties 3568 (match-beginning 5) header-end heading-props)) 3569 ))) 3570 t)) 3571 3572 (defun markdown-fontify-tables (last) 3573 (when (re-search-forward "|" last t) 3574 (when (markdown-table-at-point-p) 3575 (font-lock-append-text-property 3576 (line-beginning-position) (min (1+ (line-end-position)) (point-max)) 3577 'face 'markdown-table-face)) 3578 (forward-line 1) 3579 t)) 3580 3581 (defun markdown-fontify-blockquotes (last) 3582 "Apply font-lock properties to blockquotes from point to LAST." 3583 (when (markdown-match-blockquotes last) 3584 (let ((display-string 3585 (markdown--first-displayable markdown-blockquote-display-char))) 3586 (add-text-properties 3587 (match-beginning 1) (match-end 1) 3588 (if markdown-hide-markup 3589 `(face markdown-blockquote-face display ,display-string) 3590 `(face markdown-markup-face))) 3591 (font-lock-append-text-property 3592 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) 3593 t))) 3594 3595 (defun markdown-fontify-list-items (last) 3596 "Apply font-lock properties to list markers from point to LAST." 3597 (when (markdown-match-list-items last) 3598 (when (not (markdown-code-block-at-point-p (match-beginning 2))) 3599 (let* ((indent (length (match-string-no-properties 1))) 3600 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... 3601 (bullet (nth (mod level (length markdown-list-item-bullets)) 3602 markdown-list-item-bullets))) 3603 (add-text-properties 3604 (match-beginning 2) (match-end 2) '(face markdown-list-face)) 3605 (when markdown-hide-markup 3606 (cond 3607 ;; Unordered lists 3608 ((string-match-p "[\\*\\+-]" (match-string 2)) 3609 (add-text-properties 3610 (match-beginning 2) (match-end 2) `(display ,bullet))) 3611 ;; Definition lists 3612 ((string-equal ":" (match-string 2)) 3613 (let ((display-string 3614 (char-to-string (markdown--first-displayable 3615 markdown-definition-display-char)))) 3616 (add-text-properties (match-beginning 2) (match-end 2) 3617 `(display ,display-string)))))))) 3618 t)) 3619 3620 (defun markdown--fontify-hrs-view-mode (hr-char) 3621 (if (and hr-char (display-supports-face-attributes-p '(:extend t))) 3622 (add-text-properties 3623 (match-beginning 0) (match-end 0) 3624 `(face 3625 (:inherit markdown-hr-face :underline t :extend t) 3626 font-lock-multiline t 3627 display "\n")) 3628 (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) 3629 (add-text-properties 3630 (match-beginning 0) (match-end 0) 3631 `(face 3632 markdown-hr-face font-lock-multiline t 3633 display ,(make-string hr-len hr-char)))))) 3634 3635 (defun markdown-fontify-hrs (last) 3636 "Add text properties to horizontal rules from point to LAST." 3637 (when (markdown-match-hr last) 3638 (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) 3639 (if (and markdown-hide-markup hr-char) 3640 (markdown--fontify-hrs-view-mode hr-char) 3641 (add-text-properties 3642 (match-beginning 0) (match-end 0) 3643 `(face markdown-hr-face font-lock-multiline t))) 3644 t))) 3645 3646 (defun markdown-fontify-sub-superscripts (last) 3647 "Apply text properties to sub- and superscripts from point to LAST." 3648 (when (markdown-search-until-condition 3649 (lambda () (and (not (markdown-code-block-at-point-p)) 3650 (not (markdown-inline-code-at-point-p)) 3651 (not (markdown-in-comment-p)) 3652 (not (markdown--math-block-p)))) 3653 markdown-regex-sub-superscript last t) 3654 (let* ((subscript-p (string= (match-string 2) "~")) 3655 (props 3656 (if subscript-p 3657 (car markdown-sub-superscript-display) 3658 (cdr markdown-sub-superscript-display))) 3659 (mp (list 'face 'markdown-markup-face 3660 'invisible 'markdown-markup))) 3661 (when markdown-hide-markup 3662 (put-text-property (match-beginning 3) (match-end 3) 3663 'display props)) 3664 (add-text-properties (match-beginning 2) (match-end 2) mp) 3665 (add-text-properties (match-beginning 4) (match-end 4) mp) 3666 t))) 3667 3668 3669 ;;; Syntax Table ============================================================== 3670 3671 (defvar markdown-mode-syntax-table 3672 (let ((tab (make-syntax-table text-mode-syntax-table))) 3673 (modify-syntax-entry ?\" "." tab) 3674 tab) 3675 "Syntax table for `markdown-mode'.") 3676 3677 3678 ;;; Element Insertion ========================================================= 3679 3680 (defun markdown-ensure-blank-line-before () 3681 "If previous line is not already blank, insert a blank line before point." 3682 (unless (bolp) (insert "\n")) 3683 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) 3684 3685 (defun markdown-ensure-blank-line-after () 3686 "If following line is not already blank, insert a blank line after point. 3687 Return the point where it was originally." 3688 (save-excursion 3689 (unless (eolp) (insert "\n")) 3690 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) 3691 3692 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) 3693 "Insert the strings S1 and S2, wrapping around region or THING. 3694 If a region is specified by the optional BEG and END arguments, 3695 wrap the strings S1 and S2 around that region. 3696 If there is an active region, wrap the strings S1 and S2 around 3697 the region. If there is not an active region but the point is at 3698 THING, wrap that thing (which defaults to word). Otherwise, just 3699 insert S1 and S2 and place the point in between. Return the 3700 bounds of the entire wrapped string, or nil if nothing was wrapped 3701 and S1 and S2 were only inserted." 3702 (let (a b bounds new-point) 3703 (cond 3704 ;; Given region 3705 ((and beg end) 3706 (setq a beg 3707 b end 3708 new-point (+ (point) (length s1)))) 3709 ;; Active region 3710 ((use-region-p) 3711 (setq a (region-beginning) 3712 b (region-end) 3713 new-point (+ (point) (length s1)))) 3714 ;; Thing (word) at point 3715 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) 3716 (setq a (car bounds) 3717 b (cdr bounds) 3718 new-point (+ (point) (length s1)))) 3719 ;; No active region and no word 3720 (t 3721 (setq a (point) 3722 b (point)))) 3723 (goto-char b) 3724 (insert s2) 3725 (goto-char a) 3726 (insert s1) 3727 (when new-point (goto-char new-point)) 3728 (if (= a b) 3729 nil 3730 (setq b (+ b (length s1) (length s2))) 3731 (cons a b)))) 3732 3733 (defun markdown-point-after-unwrap (cur prefix suffix) 3734 "Return desired position of point after an unwrapping operation. 3735 CUR gives the position of the point before the operation. 3736 Additionally, two cons cells must be provided. PREFIX gives the 3737 bounds of the prefix string and SUFFIX gives the bounds of the 3738 suffix string." 3739 (cond ((< cur (cdr prefix)) (car prefix)) 3740 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) 3741 ((<= cur (cdr suffix)) 3742 (- cur (+ (- (cdr prefix) (car prefix)) 3743 (- cur (car suffix))))) 3744 (t cur))) 3745 3746 (defun markdown-unwrap-thing-at-point (regexp all text) 3747 "Remove prefix and suffix of thing at point and reposition the point. 3748 When the thing at point matches REGEXP, replace the subexpression 3749 ALL with the string in subexpression TEXT. Reposition the point 3750 in an appropriate location accounting for the removal of prefix 3751 and suffix strings. Return new bounds of string from group TEXT. 3752 When REGEXP is nil, assumes match data is already set." 3753 (when (or (null regexp) 3754 (thing-at-point-looking-at regexp)) 3755 (let ((cur (point)) 3756 (prefix (cons (match-beginning all) (match-beginning text))) 3757 (suffix (cons (match-end text) (match-end all))) 3758 (bounds (cons (match-beginning text) (match-end text)))) 3759 ;; Replace the thing at point 3760 (replace-match (match-string text) t t nil all) 3761 ;; Reposition the point 3762 (goto-char (markdown-point-after-unwrap cur prefix suffix)) 3763 ;; Adjust bounds 3764 (setq bounds (cons (car prefix) 3765 (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) 3766 3767 (defun markdown-unwrap-things-in-region (beg end regexp all text) 3768 "Remove prefix and suffix of all things in region from BEG to END. 3769 When a thing in the region matches REGEXP, replace the 3770 subexpression ALL with the string in subexpression TEXT. 3771 Return a cons cell containing updated bounds for the region." 3772 (save-excursion 3773 (goto-char beg) 3774 (let ((removed 0) len-all len-text) 3775 (while (re-search-forward regexp (- end removed) t) 3776 (setq len-all (length (match-string-no-properties all))) 3777 (setq len-text (length (match-string-no-properties text))) 3778 (setq removed (+ removed (- len-all len-text))) 3779 (replace-match (match-string text) t t nil all)) 3780 (cons beg (- end removed))))) 3781 3782 (defun markdown-insert-hr (arg) 3783 "Insert or replace a horizontal rule. 3784 By default, use the first element of `markdown-hr-strings'. When 3785 ARG is non-nil, as when given a prefix, select a different 3786 element as follows. When prefixed with \\[universal-argument], 3787 use the last element of `markdown-hr-strings' instead. When 3788 prefixed with an integer from 1 to the length of 3789 `markdown-hr-strings', use the element in that position instead." 3790 (interactive "*P") 3791 (when (thing-at-point-looking-at markdown-regex-hr) 3792 (delete-region (match-beginning 0) (match-end 0))) 3793 (markdown-ensure-blank-line-before) 3794 (cond ((equal arg '(4)) 3795 (insert (car (reverse markdown-hr-strings)))) 3796 ((and (integerp arg) (> arg 0) 3797 (<= arg (length markdown-hr-strings))) 3798 (insert (nth (1- arg) markdown-hr-strings))) 3799 (t 3800 (insert (car markdown-hr-strings)))) 3801 (markdown-ensure-blank-line-after)) 3802 3803 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face 3804 &optional skip-space) 3805 (if (use-region-p) 3806 ;; Active region 3807 (let* ((bounds (markdown-unwrap-things-in-region 3808 (region-beginning) (region-end) 3809 regex start-group end-group)) 3810 (beg (car bounds)) 3811 (end (cdr bounds))) 3812 (when (and beg skip-space) 3813 (save-excursion 3814 (goto-char beg) 3815 (skip-chars-forward "[ \t]") 3816 (setq beg (point)))) 3817 (when (and end skip-space) 3818 (save-excursion 3819 (goto-char end) 3820 (skip-chars-backward "[ \t]") 3821 (setq end (point)))) 3822 (markdown-wrap-or-insert start-delim end-delim nil beg end)) 3823 (if (markdown--face-p (point) (list face)) 3824 (save-excursion 3825 (while (and (markdown--face-p (point) (list face)) (not (bobp))) 3826 (forward-char -1)) 3827 (forward-char (- (1- (length start-delim)))) ;; for delimiter 3828 (unless (bolp) 3829 (forward-char -1)) 3830 (when (looking-at regex) 3831 (markdown-unwrap-thing-at-point nil start-group end-group))) 3832 (if (thing-at-point-looking-at regex) 3833 (markdown-unwrap-thing-at-point nil start-group end-group) 3834 (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) 3835 3836 (defun markdown-insert-bold () 3837 "Insert markup to make a region or word bold. 3838 If there is an active region, make the region bold. If the point 3839 is at a non-bold word, make the word bold. If the point is at a 3840 bold word or phrase, remove the bold markup. Otherwise, simply 3841 insert bold delimiters and place the point in between them." 3842 (interactive) 3843 (let ((delim (if markdown-bold-underscore "__" "**"))) 3844 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) 3845 3846 (defun markdown-insert-italic () 3847 "Insert markup to make a region or word italic. 3848 If there is an active region, make the region italic. If the point 3849 is at a non-italic word, make the word italic. If the point is at an 3850 italic word or phrase, remove the italic markup. Otherwise, simply 3851 insert italic delimiters and place the point in between them." 3852 (interactive) 3853 (let ((delim (if markdown-italic-underscore "_" "*"))) 3854 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) 3855 3856 (defun markdown-insert-strike-through () 3857 "Insert markup to make a region or word strikethrough. 3858 If there is an active region, make the region strikethrough. If the point 3859 is at a non-bold word, make the word strikethrough. If the point is at a 3860 strikethrough word or phrase, remove the strikethrough markup. Otherwise, 3861 simply insert bold delimiters and place the point in between them." 3862 (interactive) 3863 (markdown--insert-common 3864 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) 3865 3866 (defun markdown-insert-code () 3867 "Insert markup to make a region or word an inline code fragment. 3868 If there is an active region, make the region an inline code 3869 fragment. If the point is at a word, make the word an inline 3870 code fragment. Otherwise, simply insert code delimiters and 3871 place the point in between them." 3872 (interactive) 3873 (if (use-region-p) 3874 ;; Active region 3875 (let ((bounds (markdown-unwrap-things-in-region 3876 (region-beginning) (region-end) 3877 markdown-regex-code 1 3))) 3878 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) 3879 ;; Code markup removal, code markup for word, or empty markup insertion 3880 (if (markdown-inline-code-at-point) 3881 (markdown-unwrap-thing-at-point nil 0 2) 3882 (markdown-wrap-or-insert "`" "`" 'word nil nil)))) 3883 3884 (defun markdown-insert-kbd () 3885 "Insert markup to wrap region or word in <kbd> tags. 3886 If there is an active region, use the region. If the point is at 3887 a word, use the word. Otherwise, simply insert <kbd> tags and 3888 place the point in between them." 3889 (interactive) 3890 (if (use-region-p) 3891 ;; Active region 3892 (let ((bounds (markdown-unwrap-things-in-region 3893 (region-beginning) (region-end) 3894 markdown-regex-kbd 0 2))) 3895 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) 3896 ;; Markup removal, markup for word, or empty markup insertion 3897 (if (thing-at-point-looking-at markdown-regex-kbd) 3898 (markdown-unwrap-thing-at-point nil 0 2) 3899 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) 3900 3901 (defun markdown-insert-inline-link (text url &optional title) 3902 "Insert an inline link with TEXT pointing to URL. 3903 Optionally, the user can provide a TITLE." 3904 (let ((cur (point))) 3905 (setq title (and title (concat " \"" title "\""))) 3906 (insert (concat "[" text "](" url title ")")) 3907 (cond ((not text) (goto-char (+ 1 cur))) 3908 ((not url) (goto-char (+ 3 (length text) cur)))))) 3909 3910 (defun markdown-insert-inline-image (text url &optional title) 3911 "Insert an inline link with alt TEXT pointing to URL. 3912 Optionally, also provide a TITLE." 3913 (let ((cur (point))) 3914 (setq title (and title (concat " \"" title "\""))) 3915 (insert (concat "![" text "](" url title ")")) 3916 (cond ((not text) (goto-char (+ 2 cur))) 3917 ((not url) (goto-char (+ 4 (length text) cur)))))) 3918 3919 (defun markdown-insert-reference-link (text label &optional url title) 3920 "Insert a reference link and, optionally, a reference definition. 3921 The link TEXT will be inserted followed by the optional LABEL. 3922 If a URL is given, also insert a definition for the reference 3923 LABEL according to `markdown-reference-location'. If a TITLE is 3924 given, it will be added to the end of the reference definition 3925 and will be used to populate the title attribute when converted 3926 to XHTML. If URL is nil, insert only the link portion (for 3927 example, when a reference label is already defined)." 3928 (insert (concat "[" text "][" label "]")) 3929 (when url 3930 (markdown-insert-reference-definition 3931 (if (string-equal label "") text label) 3932 url title))) 3933 3934 (defun markdown-insert-reference-image (text label &optional url title) 3935 "Insert a reference image and, optionally, a reference definition. 3936 The alt TEXT will be inserted followed by the optional LABEL. 3937 If a URL is given, also insert a definition for the reference 3938 LABEL according to `markdown-reference-location'. If a TITLE is 3939 given, it will be added to the end of the reference definition 3940 and will be used to populate the title attribute when converted 3941 to XHTML. If URL is nil, insert only the link portion (for 3942 example, when a reference label is already defined)." 3943 (insert (concat "![" text "][" label "]")) 3944 (when url 3945 (markdown-insert-reference-definition 3946 (if (string-equal label "") text label) 3947 url title))) 3948 3949 (defun markdown-insert-reference-definition (label &optional url title) 3950 "Add definition for reference LABEL with URL and TITLE. 3951 LABEL is a Markdown reference label without square brackets. 3952 URL and TITLE are optional. When given, the TITLE will 3953 be used to populate the title attribute when converted to XHTML." 3954 ;; END specifies where to leave the point upon return 3955 (let ((end (point))) 3956 (cl-case markdown-reference-location 3957 (end (goto-char (point-max))) 3958 (immediately (markdown-end-of-text-block)) 3959 (subtree (markdown-end-of-subtree)) 3960 (header (markdown-end-of-defun))) 3961 ;; Skip backwards over local variables. This logic is similar to the one 3962 ;; used in ‘hack-local-variables’. 3963 (when (and enable-local-variables (eobp)) 3964 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) 3965 (when (let ((case-fold-search t)) 3966 (search-forward "Local Variables:" nil :move)) 3967 (beginning-of-line 0) 3968 (when (eq (char-before) ?\n) (backward-char)))) 3969 (unless (or (markdown-cur-line-blank-p) 3970 (thing-at-point-looking-at markdown-regex-reference-definition)) 3971 (insert "\n")) 3972 (insert "\n[" label "]: ") 3973 (if url 3974 (insert url) 3975 ;; When no URL is given, leave point at END following the colon 3976 (setq end (point))) 3977 (when (> (length title) 0) 3978 (insert " \"" title "\"")) 3979 (unless (looking-at-p "\n") 3980 (insert "\n")) 3981 (goto-char end) 3982 (when url 3983 (message 3984 (markdown--substitute-command-keys 3985 "Reference [%s] was defined, press \\[markdown-do] to jump there") 3986 label)))) 3987 3988 (defcustom markdown-link-make-text-function nil 3989 "Function that automatically generates a link text for a URL. 3990 3991 If non-nil, this function will be called by 3992 `markdown--insert-link-or-image' and the result will be the 3993 default link text. The function should receive exactly one 3994 argument that corresponds to the link URL." 3995 :group 'markdown 3996 :type 'function 3997 :package-version '(markdown-mode . "2.5")) 3998 3999 (defcustom markdown-disable-tooltip-prompt nil 4000 "Disable prompt for tooltip when inserting a link or image. 4001 4002 If non-nil, `markdown-insert-link' and `markdown-insert-link' 4003 will not prompt the user to insert a tooltip text for the given 4004 link or image." 4005 :group 'markdown 4006 :type 'boolean 4007 :safe 'booleanp 4008 :package-version '(markdown-mode . "2.5")) 4009 4010 (defun markdown--insert-link-or-image (image) 4011 "Interactively insert new or update an existing link or image. 4012 When IMAGE is non-nil, insert an image. Otherwise, insert a link. 4013 This is an internal function called by 4014 `markdown-insert-link' and `markdown-insert-image'." 4015 (cl-multiple-value-bind (begin end text uri ref title) 4016 (if (use-region-p) 4017 ;; Use region as either link text or URL as appropriate. 4018 (let ((region (buffer-substring-no-properties 4019 (region-beginning) (region-end)))) 4020 (if (string-match markdown-regex-uri region) 4021 ;; Region contains a URL; use it as such. 4022 (list (region-beginning) (region-end) 4023 nil (match-string 0 region) nil nil) 4024 ;; Region doesn't contain a URL, so use it as text. 4025 (list (region-beginning) (region-end) 4026 region nil nil nil))) 4027 ;; Extract and use properties of existing link, if any. 4028 (markdown-link-at-pos (point))) 4029 (let* ((ref (when ref (concat "[" ref "]"))) 4030 (defined-refs (mapcar #'car (markdown-get-defined-references))) 4031 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) 4032 (used-uris (markdown-get-used-uris)) 4033 (uri-or-ref (completing-read 4034 "URL or [reference]: " 4035 (append defined-ref-cands used-uris) 4036 nil nil (or uri ref))) 4037 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) 4038 (match-string 1 uri-or-ref)) 4039 ((string-equal "" uri-or-ref) 4040 ""))) 4041 (uri (unless ref uri-or-ref)) 4042 (text-prompt (if image 4043 "Alt text: " 4044 (if ref 4045 "Link text: " 4046 "Link text (blank for plain URL): "))) 4047 (text (or text (and markdown-link-make-text-function uri 4048 (funcall markdown-link-make-text-function uri)))) 4049 (text (completing-read text-prompt defined-refs nil nil text)) 4050 (text (if (= (length text) 0) nil text)) 4051 (plainp (and uri (not text))) 4052 (implicitp (string-equal ref "")) 4053 (ref (if implicitp text ref)) 4054 (definedp (and ref (markdown-reference-definition ref))) 4055 (ref-url (unless (or uri definedp) 4056 (completing-read "Reference URL: " used-uris))) 4057 (title (unless (or plainp definedp markdown-disable-tooltip-prompt) 4058 (read-string "Title (tooltip text, optional): " title))) 4059 (title (if (= (length title) 0) nil title))) 4060 (when (and image implicitp) 4061 (user-error "Reference required: implicit image references are invalid")) 4062 (when (and begin end) 4063 (delete-region begin end)) 4064 (cond 4065 ((and (not image) uri text) 4066 (markdown-insert-inline-link text uri title)) 4067 ((and image uri text) 4068 (markdown-insert-inline-image text uri title)) 4069 ((and ref text) 4070 (if image 4071 (markdown-insert-reference-image text (unless implicitp ref) nil title) 4072 (markdown-insert-reference-link text (unless implicitp ref) nil title)) 4073 (unless definedp 4074 (markdown-insert-reference-definition ref ref-url title))) 4075 ((and (not image) uri) 4076 (markdown-insert-uri uri)))))) 4077 4078 (defun markdown-insert-link () 4079 "Insert new or update an existing link, with interactive prompt. 4080 If the point is at an existing link or URL, update the link text, 4081 URL, reference label, and/or title. Otherwise, insert a new link. 4082 The type of link inserted (inline, reference, or plain URL) 4083 depends on which values are provided: 4084 4085 * If a URL and TEXT are given, insert an inline link: [TEXT](URL). 4086 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. 4087 * If only TEXT is given, insert an implicit reference link: [TEXT][]. 4088 * If only a URL is given, insert a plain link: <URL>. 4089 4090 In other words, to create an implicit reference link, leave the 4091 URL prompt empty and to create a plain URL link, leave the link 4092 text empty. 4093 4094 If there is an active region, use the text as the default URL, if 4095 it seems to be a URL, or link text value otherwise. 4096 4097 If a given reference is not defined, this function will 4098 additionally prompt for the URL and optional title. In this case, 4099 the reference definition is placed at the location determined by 4100 `markdown-reference-location'. In addition, it is possible to 4101 have the `markdown-link-make-text-function' function, if non-nil, 4102 define the default link text before prompting the user for it. 4103 4104 If `markdown-disable-tooltip-prompt' is non-nil, the user will 4105 not be prompted to add or modify a tooltip text. 4106 4107 Through updating the link, this function can be used to convert a 4108 link of one type (inline, reference, or plain) to another type by 4109 selectively adding or removing information via the prompts." 4110 (interactive) 4111 (markdown--insert-link-or-image nil)) 4112 4113 (defun markdown-insert-image () 4114 "Insert new or update an existing image, with interactive prompt. 4115 If the point is at an existing image, update the alt text, URL, 4116 reference label, and/or title. Otherwise, insert a new image. 4117 The type of image inserted (inline or reference) depends on which 4118 values are provided: 4119 4120 * If a URL and ALT-TEXT are given, insert an inline image: 4121 . 4122 * If [REF] and ALT-TEXT are given, insert a reference image: 4123 ![ALT-TEXT][REF]. 4124 4125 If there is an active region, use the text as the default URL, if 4126 it seems to be a URL, or alt text value otherwise. 4127 4128 If a given reference is not defined, this function will 4129 additionally prompt for the URL and optional title. In this case, 4130 the reference definition is placed at the location determined by 4131 `markdown-reference-location'. 4132 4133 Through updating the image, this function can be used to convert an 4134 image of one type (inline or reference) to another type by 4135 selectively adding or removing information via the prompts." 4136 (interactive) 4137 (markdown--insert-link-or-image t)) 4138 4139 (defun markdown-insert-uri (&optional uri) 4140 "Insert markup for an inline URI. 4141 If there is an active region, use it as the URI. If the point is 4142 at a URI, wrap it with angle brackets. If the point is at an 4143 inline URI, remove the angle brackets. Otherwise, simply insert 4144 angle brackets place the point between them." 4145 (interactive) 4146 (if (use-region-p) 4147 ;; Active region 4148 (let ((bounds (markdown-unwrap-things-in-region 4149 (region-beginning) (region-end) 4150 markdown-regex-angle-uri 0 2))) 4151 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) 4152 ;; Markup removal, URI at point, new URI, or empty markup insertion 4153 (if (thing-at-point-looking-at markdown-regex-angle-uri) 4154 (markdown-unwrap-thing-at-point nil 0 2) 4155 (if uri 4156 (insert "<" uri ">") 4157 (markdown-wrap-or-insert "<" ">" 'url nil nil))))) 4158 4159 (defun markdown-insert-wiki-link () 4160 "Insert a wiki link of the form [[WikiLink]]. 4161 If there is an active region, use the region as the link text. 4162 If the point is at a word, use the word as the link text. If 4163 there is no active region and the point is not at word, simply 4164 insert link markup." 4165 (interactive) 4166 (if (use-region-p) 4167 ;; Active region 4168 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) 4169 ;; Markup removal, wiki link at at point, or empty markup insertion 4170 (if (thing-at-point-looking-at markdown-regex-wiki-link) 4171 (if (or markdown-wiki-link-alias-first 4172 (null (match-string 5))) 4173 (markdown-unwrap-thing-at-point nil 1 3) 4174 (markdown-unwrap-thing-at-point nil 1 5)) 4175 (markdown-wrap-or-insert "[[" "]]")))) 4176 4177 (defun markdown-remove-header () 4178 "Remove header markup if point is at a header. 4179 Return bounds of remaining header text if a header was removed 4180 and nil otherwise." 4181 (interactive "*") 4182 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) 4183 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) 4184 4185 (defun markdown-insert-header (&optional level text setext) 4186 "Insert or replace header markup. 4187 The level of the header is specified by LEVEL and header text is 4188 given by TEXT. LEVEL must be an integer from 1 and 6, and the 4189 default value is 1. 4190 When TEXT is nil, the header text is obtained as follows. 4191 If there is an active region, it is used as the header text. 4192 Otherwise, the current line will be used as the header text. 4193 If there is not an active region and the point is at a header, 4194 remove the header markup and replace with level N header. 4195 Otherwise, insert empty header markup and place the point in 4196 between. 4197 The style of the header will be atx (hash marks) unless 4198 SETEXT is non-nil, in which case a setext-style (underlined) 4199 header will be inserted." 4200 (interactive "p\nsHeader text: ") 4201 (setq level (min (max (or level 1) 1) (if setext 2 6))) 4202 ;; Determine header text if not given 4203 (when (null text) 4204 (if (use-region-p) 4205 ;; Active region 4206 (setq text (delete-and-extract-region (region-beginning) (region-end))) 4207 ;; No active region 4208 (markdown-remove-header) 4209 (setq text (delete-and-extract-region 4210 (line-beginning-position) (line-end-position))) 4211 (when (and setext (string-match-p "^[ \t]*$" text)) 4212 (setq text (read-string "Header text: ")))) 4213 (setq text (markdown-compress-whitespace-string text))) 4214 ;; Insertion with given text 4215 (markdown-ensure-blank-line-before) 4216 (let (hdr) 4217 (cond (setext 4218 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) 4219 (insert text "\n" hdr)) 4220 (t 4221 (setq hdr (make-string level ?#)) 4222 (insert hdr " " text) 4223 (when (null markdown-asymmetric-header) (insert " " hdr))))) 4224 (markdown-ensure-blank-line-after) 4225 ;; Leave point at end of text 4226 (cond (setext 4227 (backward-char (1+ (string-width text)))) 4228 ((null markdown-asymmetric-header) 4229 (backward-char (1+ level))))) 4230 4231 (defun markdown-insert-header-dwim (&optional arg setext) 4232 "Insert or replace header markup. 4233 The level and type of the header are determined automatically by 4234 the type and level of the previous header, unless a prefix 4235 argument is given via ARG. 4236 With a numeric prefix valued 1 to 6, insert a header of the given 4237 level, with the type being determined automatically (note that 4238 only level 1 or 2 setext headers are possible). 4239 4240 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 4241 promote the heading by one level. 4242 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 4243 demote the heading by one level. 4244 When SETEXT is non-nil, prefer setext-style headers when 4245 possible (levels one and two). 4246 4247 When there is an active region, use it for the header text. When 4248 the point is at an existing header, change the type and level 4249 according to the rules above. 4250 Otherwise, if the line is not empty, create a header using the 4251 text on the current line as the header text. 4252 Finally, if the point is on a blank line, insert empty header 4253 markup (atx) or prompt for text (setext). 4254 See `markdown-insert-header' for more details about how the 4255 header text is determined." 4256 (interactive "*P") 4257 (let (level) 4258 (save-excursion 4259 (when (or (thing-at-point-looking-at markdown-regex-header) 4260 (re-search-backward markdown-regex-header nil t)) 4261 ;; level of current or previous header 4262 (setq level (markdown-outline-level)) 4263 ;; match group 1 indicates a setext header 4264 (setq setext (match-end 1)))) 4265 ;; check prefix argument 4266 (cond 4267 ((and (equal arg '(4)) level (> level 1)) ;; C-u 4268 (cl-decf level)) 4269 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u 4270 (cl-incf level)) 4271 (arg ;; numeric prefix 4272 (setq level (prefix-numeric-value arg)))) 4273 ;; setext headers must be level one or two 4274 (and level (setq setext (and setext (<= level 2)))) 4275 ;; insert the heading 4276 (markdown-insert-header level nil setext))) 4277 4278 (defun markdown-insert-header-setext-dwim (&optional arg) 4279 "Insert or replace header markup, with preference for setext. 4280 See `markdown-insert-header-dwim' for details, including how ARG is handled." 4281 (interactive "*P") 4282 (markdown-insert-header-dwim arg t)) 4283 4284 (defun markdown-insert-header-atx-1 () 4285 "Insert a first level atx-style (hash mark) header. 4286 See `markdown-insert-header'." 4287 (interactive "*") 4288 (markdown-insert-header 1 nil nil)) 4289 4290 (defun markdown-insert-header-atx-2 () 4291 "Insert a level two atx-style (hash mark) header. 4292 See `markdown-insert-header'." 4293 (interactive "*") 4294 (markdown-insert-header 2 nil nil)) 4295 4296 (defun markdown-insert-header-atx-3 () 4297 "Insert a level three atx-style (hash mark) header. 4298 See `markdown-insert-header'." 4299 (interactive "*") 4300 (markdown-insert-header 3 nil nil)) 4301 4302 (defun markdown-insert-header-atx-4 () 4303 "Insert a level four atx-style (hash mark) header. 4304 See `markdown-insert-header'." 4305 (interactive "*") 4306 (markdown-insert-header 4 nil nil)) 4307 4308 (defun markdown-insert-header-atx-5 () 4309 "Insert a level five atx-style (hash mark) header. 4310 See `markdown-insert-header'." 4311 (interactive "*") 4312 (markdown-insert-header 5 nil nil)) 4313 4314 (defun markdown-insert-header-atx-6 () 4315 "Insert a sixth level atx-style (hash mark) header. 4316 See `markdown-insert-header'." 4317 (interactive "*") 4318 (markdown-insert-header 6 nil nil)) 4319 4320 (defun markdown-insert-header-setext-1 () 4321 "Insert a setext-style (underlined) first-level header. 4322 See `markdown-insert-header'." 4323 (interactive "*") 4324 (markdown-insert-header 1 nil t)) 4325 4326 (defun markdown-insert-header-setext-2 () 4327 "Insert a setext-style (underlined) second-level header. 4328 See `markdown-insert-header'." 4329 (interactive "*") 4330 (markdown-insert-header 2 nil t)) 4331 4332 (defun markdown-blockquote-indentation (loc) 4333 "Return string containing necessary indentation for a blockquote at LOC. 4334 Also see `markdown-pre-indentation'." 4335 (save-excursion 4336 (goto-char loc) 4337 (let* ((list-level (length (markdown-calculate-list-levels))) 4338 (indent "")) 4339 (dotimes (_ list-level indent) 4340 (setq indent (concat indent " ")))))) 4341 4342 (defun markdown-insert-blockquote () 4343 "Start a blockquote section (or blockquote the region). 4344 If Transient Mark mode is on and a region is active, it is used as 4345 the blockquote text." 4346 (interactive) 4347 (if (use-region-p) 4348 (markdown-blockquote-region (region-beginning) (region-end)) 4349 (markdown-ensure-blank-line-before) 4350 (insert (markdown-blockquote-indentation (point)) "> ") 4351 (markdown-ensure-blank-line-after))) 4352 4353 (defun markdown-block-region (beg end prefix) 4354 "Format the region using a block prefix. 4355 Arguments BEG and END specify the beginning and end of the 4356 region. The characters PREFIX will appear at the beginning 4357 of each line." 4358 (save-excursion 4359 (let* ((end-marker (make-marker)) 4360 (beg-marker (make-marker)) 4361 (prefix-without-trailing-whitespace 4362 (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) 4363 ;; Ensure blank line after and remove extra whitespace 4364 (goto-char end) 4365 (skip-syntax-backward "-") 4366 (set-marker end-marker (point)) 4367 (delete-horizontal-space) 4368 (markdown-ensure-blank-line-after) 4369 ;; Ensure blank line before and remove extra whitespace 4370 (goto-char beg) 4371 (skip-syntax-forward "-") 4372 (delete-horizontal-space) 4373 (markdown-ensure-blank-line-before) 4374 (set-marker beg-marker (point)) 4375 ;; Insert PREFIX before each line 4376 (goto-char beg-marker) 4377 (while (and (< (line-beginning-position) end-marker) 4378 (not (eobp))) 4379 ;; Don’t insert trailing whitespace. 4380 (insert (if (eolp) prefix-without-trailing-whitespace prefix)) 4381 (forward-line))))) 4382 4383 (defun markdown-blockquote-region (beg end) 4384 "Blockquote the region. 4385 Arguments BEG and END specify the beginning and end of the region." 4386 (interactive "*r") 4387 (markdown-block-region 4388 beg end (concat (markdown-blockquote-indentation 4389 (max (point-min) (1- beg))) "> "))) 4390 4391 (defun markdown-pre-indentation (loc) 4392 "Return string containing necessary whitespace for a pre block at LOC. 4393 Also see `markdown-blockquote-indentation'." 4394 (save-excursion 4395 (goto-char loc) 4396 (let* ((list-level (length (markdown-calculate-list-levels))) 4397 indent) 4398 (dotimes (_ (1+ list-level) indent) 4399 (setq indent (concat indent " ")))))) 4400 4401 (defun markdown-insert-pre () 4402 "Start a preformatted section (or apply to the region). 4403 If Transient Mark mode is on and a region is active, it is marked 4404 as preformatted text." 4405 (interactive) 4406 (if (use-region-p) 4407 (markdown-pre-region (region-beginning) (region-end)) 4408 (markdown-ensure-blank-line-before) 4409 (insert (markdown-pre-indentation (point))) 4410 (markdown-ensure-blank-line-after))) 4411 4412 (defun markdown-pre-region (beg end) 4413 "Format the region as preformatted text. 4414 Arguments BEG and END specify the beginning and end of the region." 4415 (interactive "*r") 4416 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) 4417 (markdown-block-region beg end indent))) 4418 4419 (defun markdown-electric-backquote (arg) 4420 "Insert a backquote. 4421 The numeric prefix argument ARG says how many times to repeat the insertion. 4422 Call `markdown-insert-gfm-code-block' interactively 4423 if three backquotes inserted at the beginning of line." 4424 (interactive "*P") 4425 (self-insert-command (prefix-numeric-value arg)) 4426 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) 4427 (replace-match "") 4428 (call-interactively #'markdown-insert-gfm-code-block))) 4429 4430 (defconst markdown-gfm-recognized-languages 4431 ;; To reproduce/update, evaluate the let-form in 4432 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, 4433 ;; but with appropriate use of a keyboard macro, indenting and filling it 4434 ;; properly is pretty fast. 4435 '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" 4436 "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" 4437 "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" 4438 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" 4439 "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" 4440 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" 4441 "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" 4442 "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" 4443 "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" 4444 "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" 4445 "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" 4446 "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" 4447 "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" 4448 "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" 4449 "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" 4450 "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" 4451 "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" 4452 "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" 4453 "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" 4454 "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" 4455 "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" 4456 "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" 4457 "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" 4458 "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" 4459 "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" 4460 "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" 4461 "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" 4462 "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" 4463 "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" 4464 "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" 4465 "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" 4466 "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" 4467 "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" 4468 "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" 4469 "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" 4470 "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" 4471 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" 4472 "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" 4473 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" 4474 "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" 4475 "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" 4476 "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" 4477 "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" 4478 "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" 4479 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" 4480 "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" 4481 "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" 4482 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" 4483 "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" 4484 "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" 4485 "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" 4486 "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" 4487 "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" 4488 "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" 4489 "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" 4490 "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" 4491 "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" 4492 "Linux-Kernel-Module" "Liquid" "Literate-Agda" 4493 "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" 4494 "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" 4495 "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" 4496 "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" 4497 "Max" "Mercury" "Mermaid" "Meson" "Metal" 4498 "Microsoft-Developer-Studio-Project" 4499 "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" 4500 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" 4501 "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" 4502 "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" 4503 "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" 4504 "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" 4505 "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" 4506 "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" 4507 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" 4508 "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" 4509 "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" 4510 "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" 4511 "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" 4512 "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" 4513 "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" 4514 "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" 4515 "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" 4516 "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" 4517 "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" 4518 "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" 4519 "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" 4520 "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" 4521 "PureBasic" "PureScript" "Pyret" "Python" "Python-console" 4522 "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" 4523 "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" 4524 "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" 4525 "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" 4526 "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" 4527 "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" 4528 "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" 4529 "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" 4530 "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" 4531 "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" 4532 "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" 4533 "ShellCheck-Config" "ShellSession" "Shen" "Sieve" 4534 "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" 4535 "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" 4536 "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" 4537 "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" 4538 "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" 4539 "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" 4540 "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" 4541 "Terraform-Template" "Texinfo" "Text" "TextGrid" 4542 "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" 4543 "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" 4544 "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" 4545 "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" 4546 "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" 4547 "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" 4548 "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" 4549 "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" 4550 "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" 4551 "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" 4552 "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" 4553 "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" 4554 "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" 4555 "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" 4556 "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" 4557 "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" 4558 "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" 4559 "reStructuredText" "robots.txt" "sed" "wisp" "xBase") 4560 "Language specifiers recognized by GitHub's syntax highlighting features.") 4561 4562 (defvar-local markdown-gfm-used-languages nil 4563 "Language names used in GFM code blocks.") 4564 4565 (defun markdown-trim-whitespace (str) 4566 (replace-regexp-in-string 4567 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) 4568 4569 (defun markdown-clean-language-string (str) 4570 (replace-regexp-in-string 4571 "{\\.?\\|}" "" (markdown-trim-whitespace str))) 4572 4573 (defun markdown-validate-language-string (widget) 4574 (let ((str (widget-value widget))) 4575 (unless (string= str (markdown-clean-language-string str)) 4576 (widget-put widget :error (format "Invalid language spec: '%s'" str)) 4577 widget))) 4578 4579 (defun markdown-gfm-get-corpus () 4580 "Create corpus of recognized GFM code block languages for the given buffer." 4581 (let ((given-corpus (append markdown-gfm-additional-languages 4582 markdown-gfm-recognized-languages))) 4583 (append 4584 markdown-gfm-used-languages 4585 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) 4586 given-corpus)))) 4587 4588 (defun markdown-gfm-add-used-language (lang) 4589 "Clean LANG and add to list of used languages." 4590 (setq markdown-gfm-used-languages 4591 (cons lang (remove lang markdown-gfm-used-languages)))) 4592 4593 (defcustom markdown-spaces-after-code-fence 1 4594 "Number of space characters to insert after a code fence. 4595 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an 4596 opening code fence and an info string." 4597 :group 'markdown 4598 :type 'integer 4599 :safe #'natnump 4600 :package-version '(markdown-mode . "2.3")) 4601 4602 (defcustom markdown-code-block-braces nil 4603 "When non-nil, automatically insert braces for GFM code blocks." 4604 :group 'markdown 4605 :type 'boolean) 4606 4607 (defun markdown-insert-gfm-code-block (&optional lang edit) 4608 "Insert GFM code block for language LANG. 4609 If LANG is nil, the language will be queried from user. If a 4610 region is active, wrap this region with the markup instead. If 4611 the region boundaries are not on empty lines, these are added 4612 automatically in order to have the correct markup. When EDIT is 4613 non-nil (e.g., when \\[universal-argument] is given), edit the 4614 code block in an indirect buffer after insertion." 4615 (interactive 4616 (list (let ((completion-ignore-case nil)) 4617 (condition-case nil 4618 (markdown-clean-language-string 4619 (completing-read 4620 "Programming language: " 4621 (markdown-gfm-get-corpus) 4622 nil 'confirm (car markdown-gfm-used-languages) 4623 'markdown-gfm-language-history)) 4624 (quit ""))) 4625 current-prefix-arg)) 4626 (unless (string= lang "") (markdown-gfm-add-used-language lang)) 4627 (when (and (> (length lang) 0) 4628 (not markdown-code-block-braces)) 4629 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) 4630 lang))) 4631 (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) 4632 (gfm-close-brace (if markdown-code-block-braces "}" ""))) 4633 (if (use-region-p) 4634 (let* ((b (region-beginning)) (e (region-end)) end 4635 (indent (progn (goto-char b) (current-indentation)))) 4636 (goto-char e) 4637 ;; if we're on a blank line, don't newline, otherwise the ``` 4638 ;; should go on its own line 4639 (unless (looking-back "\n" nil) 4640 (newline)) 4641 (indent-to indent) 4642 (insert "```") 4643 (markdown-ensure-blank-line-after) 4644 (setq end (point)) 4645 (goto-char b) 4646 ;; if we're on a blank line, insert the quotes here, otherwise 4647 ;; add a new line first 4648 (unless (looking-at-p "\n") 4649 (newline) 4650 (forward-line -1)) 4651 (markdown-ensure-blank-line-before) 4652 (indent-to indent) 4653 (insert "```" gfm-open-brace lang gfm-close-brace) 4654 (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) 4655 (let ((indent (current-indentation)) 4656 start-bol) 4657 (delete-horizontal-space :backward-only) 4658 (markdown-ensure-blank-line-before) 4659 (indent-to indent) 4660 (setq start-bol (line-beginning-position)) 4661 (insert "```" gfm-open-brace lang gfm-close-brace "\n") 4662 (indent-to indent) 4663 (unless edit (insert ?\n)) 4664 (indent-to indent) 4665 (insert "```") 4666 (markdown-ensure-blank-line-after) 4667 (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) 4668 (end-of-line 0) 4669 (when edit (markdown-edit-code-block))))) 4670 4671 (defun markdown-code-block-lang (&optional pos-prop) 4672 "Return the language name for a GFM or tilde fenced code block. 4673 The beginning of the block may be described by POS-PROP, 4674 a cons of (pos . prop) giving the position and property 4675 at the beginning of the block." 4676 (or pos-prop 4677 (setq pos-prop 4678 (markdown-max-of-seq 4679 #'car 4680 (cl-remove-if 4681 #'null 4682 (cl-mapcar 4683 #'markdown-find-previous-prop 4684 (markdown-get-fenced-block-begin-properties)))))) 4685 (when pos-prop 4686 (goto-char (car pos-prop)) 4687 (set-match-data (get-text-property (point) (cdr pos-prop))) 4688 ;; Note: Hard-coded group number assumes tilde 4689 ;; and GFM fenced code regexp groups agree. 4690 (let ((begin (match-beginning 3)) 4691 (end (match-end 3))) 4692 (when (and begin end) 4693 ;; Fix language strings beginning with periods, like ".ruby". 4694 (when (eq (char-after begin) ?.) 4695 (setq begin (1+ begin))) 4696 (buffer-substring-no-properties begin end))))) 4697 4698 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer) 4699 (with-current-buffer (or buffer (current-buffer)) 4700 (save-excursion 4701 (goto-char (point-min)) 4702 (cl-loop 4703 with prop = 'markdown-gfm-block-begin 4704 for pos-prop = (markdown-find-next-prop prop) 4705 while pos-prop 4706 for lang = (markdown-code-block-lang pos-prop) 4707 do (progn (when lang (markdown-gfm-add-used-language lang)) 4708 (goto-char (next-single-property-change (point) prop))))))) 4709 4710 (defun markdown-insert-foldable-block () 4711 "Insert details disclosure element to make content foldable. 4712 If a region is active, wrap this region with the disclosure 4713 element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." 4714 (interactive) 4715 (let ((details-open-tag "<details>") 4716 (details-close-tag "</details>") 4717 (summary-open-tag "<summary>") 4718 (summary-close-tag " </summary>")) 4719 (if (use-region-p) 4720 (let* ((b (region-beginning)) 4721 (e (region-end)) 4722 (indent (progn (goto-char b) (current-indentation)))) 4723 (goto-char e) 4724 ;; if we're on a blank line, don't newline, otherwise the tags 4725 ;; should go on its own line 4726 (unless (looking-back "\n" nil) 4727 (newline)) 4728 (indent-to indent) 4729 (insert details-close-tag) 4730 (markdown-ensure-blank-line-after) 4731 (goto-char b) 4732 ;; if we're on a blank line, insert the quotes here, otherwise 4733 ;; add a new line first 4734 (unless (looking-at-p "\n") 4735 (newline) 4736 (forward-line -1)) 4737 (markdown-ensure-blank-line-before) 4738 (indent-to indent) 4739 (insert details-open-tag "\n") 4740 (insert summary-open-tag summary-close-tag) 4741 (search-backward summary-close-tag)) 4742 (let ((indent (current-indentation))) 4743 (delete-horizontal-space :backward-only) 4744 (markdown-ensure-blank-line-before) 4745 (indent-to indent) 4746 (insert details-open-tag "\n") 4747 (insert summary-open-tag summary-close-tag "\n") 4748 (insert details-close-tag) 4749 (indent-to indent) 4750 (markdown-ensure-blank-line-after) 4751 (search-backward summary-close-tag))))) 4752 4753 4754 ;;; Footnotes ================================================================= 4755 4756 (defun markdown-footnote-counter-inc () 4757 "Increment `markdown-footnote-counter' and return the new value." 4758 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. 4759 (save-excursion 4760 (goto-char (point-min)) 4761 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") 4762 (point-max) t) 4763 (let ((fn (string-to-number (match-string 1)))) 4764 (when (> fn markdown-footnote-counter) 4765 (setq markdown-footnote-counter fn)))))) 4766 (cl-incf markdown-footnote-counter)) 4767 4768 (defun markdown-insert-footnote () 4769 "Insert footnote with a new number and move point to footnote definition." 4770 (interactive) 4771 (let ((fn (markdown-footnote-counter-inc))) 4772 (insert (format "[^%d]" fn)) 4773 (push-mark (point) t) 4774 (markdown-footnote-text-find-new-location) 4775 (markdown-ensure-blank-line-before) 4776 (unless (markdown-cur-line-blank-p) 4777 (insert "\n")) 4778 (insert (format "[^%d]: " fn)) 4779 (markdown-ensure-blank-line-after))) 4780 4781 (defun markdown-footnote-text-find-new-location () 4782 "Position the point at the proper location for a new footnote text." 4783 (cond 4784 ((eq markdown-footnote-location 'end) (goto-char (point-max))) 4785 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) 4786 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) 4787 ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) 4788 4789 (defun markdown-footnote-kill () 4790 "Kill the footnote at point. 4791 The footnote text is killed (and added to the kill ring), the 4792 footnote marker is deleted. Point has to be either at the 4793 footnote marker or in the footnote text." 4794 (interactive) 4795 (let ((marker-pos nil) 4796 (skip-deleting-marker nil) 4797 (starting-footnote-text-positions 4798 (markdown-footnote-text-positions))) 4799 (when starting-footnote-text-positions 4800 ;; We're starting in footnote text, so mark our return position and jump 4801 ;; to the marker if possible. 4802 (let ((marker-pos (markdown-footnote-find-marker 4803 (cl-first starting-footnote-text-positions)))) 4804 (if marker-pos 4805 (goto-char (1- marker-pos)) 4806 ;; If there isn't a marker, we still want to kill the text. 4807 (setq skip-deleting-marker t)))) 4808 ;; Either we didn't start in the text, or we started in the text and jumped 4809 ;; to the marker. We want to assume we're at the marker now and error if 4810 ;; we're not. 4811 (unless skip-deleting-marker 4812 (let ((marker (markdown-footnote-delete-marker))) 4813 (unless marker 4814 (error "Not at a footnote")) 4815 ;; Even if we knew the text position before, it changed when we deleted 4816 ;; the label. 4817 (setq marker-pos (cl-second marker)) 4818 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) 4819 (unless new-text-pos 4820 (error "No text for footnote `%s'" (cl-first marker))) 4821 (goto-char new-text-pos)))) 4822 (let ((pos (markdown-footnote-kill-text))) 4823 (goto-char (if starting-footnote-text-positions 4824 pos 4825 marker-pos))))) 4826 4827 (defun markdown-footnote-delete-marker () 4828 "Delete a footnote marker at point. 4829 Returns a list (ID START) containing the footnote ID and the 4830 start position of the marker before deletion. If no footnote 4831 marker was deleted, this function returns NIL." 4832 (let ((marker (markdown-footnote-marker-positions))) 4833 (when marker 4834 (delete-region (cl-second marker) (cl-third marker)) 4835 (butlast marker)))) 4836 4837 (defun markdown-footnote-kill-text () 4838 "Kill footnote text at point. 4839 Returns the start position of the footnote text before deletion, 4840 or NIL if point was not inside a footnote text. 4841 4842 The killed text is placed in the kill ring (without the footnote 4843 number)." 4844 (let ((fn (markdown-footnote-text-positions))) 4845 (when fn 4846 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) 4847 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) 4848 (kill-new (match-string 1 text)) 4849 (when (and (markdown-cur-line-blank-p) 4850 (markdown-prev-line-blank-p) 4851 (not (bobp))) 4852 (delete-region (1- (point)) (point))) 4853 (cl-second fn))))) 4854 4855 (defun markdown-footnote-goto-text () 4856 "Jump to the text of the footnote at point." 4857 (interactive) 4858 (let ((fn (car (markdown-footnote-marker-positions)))) 4859 (unless fn 4860 (user-error "Not at a footnote marker")) 4861 (let ((new-pos (markdown-footnote-find-text fn))) 4862 (unless new-pos 4863 (error "No definition found for footnote `%s'" fn)) 4864 (goto-char new-pos)))) 4865 4866 (defun markdown-footnote-return () 4867 "Return from a footnote to its footnote number in the main text." 4868 (interactive) 4869 (let ((fn (save-excursion 4870 (car (markdown-footnote-text-positions))))) 4871 (unless fn 4872 (user-error "Not in a footnote")) 4873 (let ((new-pos (markdown-footnote-find-marker fn))) 4874 (unless new-pos 4875 (error "Footnote marker `%s' not found" fn)) 4876 (goto-char new-pos)))) 4877 4878 (defun markdown-footnote-find-marker (id) 4879 "Find the location of the footnote marker with ID. 4880 The actual buffer position returned is the position directly 4881 following the marker's closing bracket. If no marker is found, 4882 NIL is returned." 4883 (save-excursion 4884 (goto-char (point-min)) 4885 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) 4886 (skip-chars-backward "^]") 4887 (point)))) 4888 4889 (defun markdown-footnote-find-text (id) 4890 "Find the location of the text of footnote ID. 4891 The actual buffer position returned is the position of the first 4892 character of the text, after the footnote's identifier. If no 4893 footnote text is found, NIL is returned." 4894 (save-excursion 4895 (goto-char (point-min)) 4896 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) 4897 (skip-chars-forward "[ \t]") 4898 (point)))) 4899 4900 (defun markdown-footnote-marker-positions () 4901 "Return the position and ID of the footnote marker point is on. 4902 The return value is a list (ID START END). If point is not on a 4903 footnote, NIL is returned." 4904 ;; first make sure we're at a footnote marker 4905 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) 4906 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) 4907 (save-excursion 4908 ;; move point between [ and ^: 4909 (if (looking-at-p "\\[") 4910 (forward-char 1) 4911 (skip-chars-backward "^[")) 4912 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) 4913 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) 4914 4915 (defun markdown-footnote-text-positions () 4916 "Return the start and end positions of the footnote text point is in. 4917 The exact return value is a list of three elements: (ID START END). 4918 The start position is the position of the opening bracket 4919 of the footnote id. The end position is directly after the 4920 newline that ends the footnote. If point is not in a footnote, 4921 NIL is returned instead." 4922 (save-excursion 4923 (let (result) 4924 (move-beginning-of-line 1) 4925 ;; Try to find the label. If we haven't found the label and we're at a blank 4926 ;; or indented line, back up if possible. 4927 (while (and 4928 (not (and (looking-at markdown-regex-footnote-definition) 4929 (setq result (list (match-string 1) (point))))) 4930 (and (not (bobp)) 4931 (or (markdown-cur-line-blank-p) 4932 (>= (current-indentation) 4)))) 4933 (forward-line -1)) 4934 (when result 4935 ;; Advance if there is a next line that is either blank or indented. 4936 ;; (Need to check if we're on the last line, because 4937 ;; markdown-next-line-blank-p returns true for last line in buffer.) 4938 (while (and (/= (line-end-position) (point-max)) 4939 (or (markdown-next-line-blank-p) 4940 (>= (markdown-next-line-indent) 4))) 4941 (forward-line)) 4942 ;; Move back while the current line is blank. 4943 (while (markdown-cur-line-blank-p) 4944 (forward-line -1)) 4945 ;; Advance to capture this line and a single trailing newline (if there 4946 ;; is one). 4947 (forward-line) 4948 (append result (list (point))))))) 4949 4950 (defun markdown-get-defined-footnotes () 4951 "Return a list of all defined footnotes. 4952 Result is an alist of pairs (MARKER . LINE), where MARKER is the 4953 footnote marker, a string, and LINE is the line number containing 4954 the footnote definition. 4955 4956 For example, suppose the following footnotes are defined at positions 4957 448 and 475: 4958 4959 \[^1]: First footnote here. 4960 \[^marker]: Second footnote. 4961 4962 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" 4963 (save-excursion 4964 (goto-char (point-min)) 4965 (let (footnotes) 4966 (while (markdown-search-until-condition 4967 (lambda () (and (not (markdown-code-block-at-point-p)) 4968 (not (markdown-inline-code-at-point-p)) 4969 (not (markdown-in-comment-p)))) 4970 markdown-regex-footnote-definition nil t) 4971 (let ((marker (match-string-no-properties 1)) 4972 (pos (match-beginning 0))) 4973 (unless (zerop (length marker)) 4974 (cl-pushnew (cons marker pos) footnotes :test #'equal)))) 4975 (reverse footnotes)))) 4976 4977 4978 ;;; Element Removal =========================================================== 4979 4980 (defun markdown-kill-thing-at-point () 4981 "Kill thing at point and add important text, without markup, to kill ring. 4982 Possible things to kill include (roughly in order of precedence): 4983 inline code, headers, horizontal rules, links (add link text to 4984 kill ring), images (add alt text to kill ring), angle uri, email 4985 addresses, bold, italics, reference definition (add URI to kill 4986 ring), footnote markers and text (kill both marker and text, add 4987 text to kill ring), and list items." 4988 (interactive "*") 4989 (let (val) 4990 (cond 4991 ;; Inline code 4992 ((markdown-inline-code-at-point) 4993 (kill-new (match-string 2)) 4994 (delete-region (match-beginning 0) (match-end 0))) 4995 ;; ATX header 4996 ((thing-at-point-looking-at markdown-regex-header-atx) 4997 (kill-new (match-string 2)) 4998 (delete-region (match-beginning 0) (match-end 0))) 4999 ;; Setext header 5000 ((thing-at-point-looking-at markdown-regex-header-setext) 5001 (kill-new (match-string 1)) 5002 (delete-region (match-beginning 0) (match-end 0))) 5003 ;; Horizontal rule 5004 ((thing-at-point-looking-at markdown-regex-hr) 5005 (kill-new (match-string 0)) 5006 (delete-region (match-beginning 0) (match-end 0))) 5007 ;; Inline link or image (add link or alt text to kill ring) 5008 ((thing-at-point-looking-at markdown-regex-link-inline) 5009 (kill-new (match-string 3)) 5010 (delete-region (match-beginning 0) (match-end 0))) 5011 ;; Reference link or image (add link or alt text to kill ring) 5012 ((thing-at-point-looking-at markdown-regex-link-reference) 5013 (kill-new (match-string 3)) 5014 (delete-region (match-beginning 0) (match-end 0))) 5015 ;; Angle URI (add URL to kill ring) 5016 ((thing-at-point-looking-at markdown-regex-angle-uri) 5017 (kill-new (match-string 2)) 5018 (delete-region (match-beginning 0) (match-end 0))) 5019 ;; Email address in angle brackets (add email address to kill ring) 5020 ((thing-at-point-looking-at markdown-regex-email) 5021 (kill-new (match-string 1)) 5022 (delete-region (match-beginning 0) (match-end 0))) 5023 ;; Wiki link (add alias text to kill ring) 5024 ((and markdown-enable-wiki-links 5025 (thing-at-point-looking-at markdown-regex-wiki-link)) 5026 (kill-new (markdown-wiki-link-alias)) 5027 (delete-region (match-beginning 1) (match-end 1))) 5028 ;; Bold 5029 ((thing-at-point-looking-at markdown-regex-bold) 5030 (kill-new (match-string 4)) 5031 (delete-region (match-beginning 2) (match-end 2))) 5032 ;; Italics 5033 ((thing-at-point-looking-at markdown-regex-italic) 5034 (kill-new (match-string 3)) 5035 (delete-region (match-beginning 1) (match-end 1))) 5036 ;; Strikethrough 5037 ((thing-at-point-looking-at markdown-regex-strike-through) 5038 (kill-new (match-string 4)) 5039 (delete-region (match-beginning 2) (match-end 2))) 5040 ;; Footnote marker (add footnote text to kill ring) 5041 ((thing-at-point-looking-at markdown-regex-footnote) 5042 (markdown-footnote-kill)) 5043 ;; Footnote text (add footnote text to kill ring) 5044 ((setq val (markdown-footnote-text-positions)) 5045 (markdown-footnote-kill)) 5046 ;; Reference definition (add URL to kill ring) 5047 ((thing-at-point-looking-at markdown-regex-reference-definition) 5048 (kill-new (match-string 5)) 5049 (delete-region (match-beginning 0) (match-end 0))) 5050 ;; List item 5051 ((setq val (markdown-cur-list-item-bounds)) 5052 (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) 5053 (t 5054 (user-error "Nothing found at point to kill"))))) 5055 5056 (defun markdown-kill-outline () 5057 "Kill visible heading and add it to `kill-ring'." 5058 (interactive) 5059 (save-excursion 5060 (markdown-outline-previous) 5061 (kill-region (point) (progn (markdown-outline-next) (point))))) 5062 5063 (defun markdown-kill-block () 5064 "Kill visible code block, list item, or blockquote and add it to `kill-ring'." 5065 (interactive) 5066 (save-excursion 5067 (markdown-backward-block) 5068 (kill-region (point) (progn (markdown-forward-block) (point))))) 5069 5070 5071 ;;; Indentation =============================================================== 5072 5073 (defun markdown-indent-find-next-position (cur-pos positions) 5074 "Return the position after the index of CUR-POS in POSITIONS. 5075 Positions are calculated by `markdown-calc-indents'." 5076 (while (and positions 5077 (not (equal cur-pos (car positions)))) 5078 (setq positions (cdr positions))) 5079 (or (cadr positions) 0)) 5080 5081 (defun markdown-outdent-find-next-position (cur-pos positions) 5082 "Return the maximal element that precedes CUR-POS from POSITIONS. 5083 Positions are calculated by `markdown-calc-indents'." 5084 (let ((result 0)) 5085 (dolist (i positions) 5086 (when (< i cur-pos) 5087 (setq result (max result i)))) 5088 result)) 5089 5090 (defun markdown-indent-line () 5091 "Indent the current line using some heuristics. 5092 If the _previous_ command was either `markdown-enter-key' or 5093 `markdown-cycle', then we should cycle to the next 5094 reasonable indentation position. Otherwise, we could have been 5095 called directly by `markdown-enter-key', by an initial call of 5096 `markdown-cycle', or indirectly by `auto-fill-mode'. In 5097 these cases, indent to the default position. 5098 Positions are calculated by `markdown-calc-indents'." 5099 (interactive) 5100 (let ((positions (markdown-calc-indents)) 5101 (point-pos (current-column)) 5102 (_ (back-to-indentation)) 5103 (cur-pos (current-column))) 5104 (if (not (equal this-command 'markdown-cycle)) 5105 (indent-line-to (car positions)) 5106 (setq positions (sort (delete-dups positions) '<)) 5107 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) 5108 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) 5109 (indent-line-to next-pos) 5110 (move-to-column new-point-pos))))) 5111 5112 (defun markdown-calc-indents () 5113 "Return a list of indentation columns to cycle through. 5114 The first element in the returned list should be considered the 5115 default indentation level. This function does not worry about 5116 duplicate positions, which are handled up by calling functions." 5117 (let (pos prev-line-pos positions) 5118 5119 ;; Indentation of previous line 5120 (setq prev-line-pos (markdown-prev-line-indent)) 5121 (setq positions (cons prev-line-pos positions)) 5122 5123 ;; Indentation of previous non-list-marker text 5124 (when (setq pos (save-excursion 5125 (forward-line -1) 5126 (when (looking-at markdown-regex-list) 5127 (- (match-end 3) (match-beginning 0))))) 5128 (setq positions (cons pos positions))) 5129 5130 ;; Indentation required for a pre block in current context 5131 (setq pos (length (markdown-pre-indentation (point)))) 5132 (setq positions (cons pos positions)) 5133 5134 ;; Indentation of the previous line + tab-width 5135 (if prev-line-pos 5136 (setq positions (cons (+ prev-line-pos tab-width) positions)) 5137 (setq positions (cons tab-width positions))) 5138 5139 ;; Indentation of the previous line - tab-width 5140 (if (and prev-line-pos (> prev-line-pos tab-width)) 5141 (setq positions (cons (- prev-line-pos tab-width) positions))) 5142 5143 ;; Indentation of all preceding list markers (when in a list) 5144 (when (setq pos (markdown-calculate-list-levels)) 5145 (setq positions (append pos positions))) 5146 5147 ;; First column 5148 (setq positions (cons 0 positions)) 5149 5150 ;; Return reversed list 5151 (reverse positions))) 5152 5153 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent 5154 "Handle RET depending on the context. 5155 If the point is at a table, move to the next row. Otherwise, 5156 indent according to value of `markdown-indent-on-enter'. 5157 When it is nil, simply call `newline'. Otherwise, indent the next line 5158 following RET using `markdown-indent-line'. Furthermore, when it 5159 is set to \\='indent-and-new-item and the point is in a list item, 5160 start a new item with the same indentation. If the point is in an 5161 empty list item, remove it (so that pressing RET twice when in a 5162 list simply adds a blank line)." 5163 (interactive) 5164 (cond 5165 ;; Table 5166 ((markdown-table-at-point-p) 5167 (call-interactively #'markdown-table-next-row)) 5168 ;; Indent non-table text 5169 (markdown-indent-on-enter 5170 (let (bounds) 5171 (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) 5172 (setq bounds (markdown-cur-list-item-bounds))) 5173 (let ((beg (cl-first bounds)) 5174 (end (cl-second bounds)) 5175 (nonlist-indent (cl-fourth bounds)) 5176 (checkbox (cl-sixth bounds))) 5177 ;; Point is in a list item 5178 (if (= (- end beg) (+ nonlist-indent (length checkbox))) 5179 ;; Delete blank list 5180 (progn 5181 (delete-region beg end) 5182 (newline) 5183 (markdown-indent-line)) 5184 (call-interactively #'markdown-insert-list-item))) 5185 ;; Point is not in a list 5186 (newline) 5187 (markdown-indent-line)))) 5188 ;; Insert a raw newline 5189 (t (newline)))) 5190 5191 (defun markdown-outdent-or-delete (arg) 5192 "Handle BACKSPACE by cycling through indentation points. 5193 When BACKSPACE is pressed, if there is only whitespace 5194 before the current point, then outdent the line one level. 5195 Otherwise, do normal delete by repeating 5196 `backward-delete-char-untabify' ARG times." 5197 (interactive "*p") 5198 (if (use-region-p) 5199 (backward-delete-char-untabify arg) 5200 (let ((cur-pos (current-column)) 5201 (start-of-indention (save-excursion 5202 (back-to-indentation) 5203 (current-column))) 5204 (positions (markdown-calc-indents))) 5205 (if (and (> cur-pos 0) (= cur-pos start-of-indention)) 5206 (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) 5207 (backward-delete-char-untabify arg))))) 5208 5209 (defun markdown-find-leftmost-column (beg end) 5210 "Find the leftmost column in the region from BEG to END." 5211 (let ((mincol 1000)) 5212 (save-excursion 5213 (goto-char beg) 5214 (while (< (point) end) 5215 (back-to-indentation) 5216 (unless (looking-at-p "[ \t]*$") 5217 (setq mincol (min mincol (current-column)))) 5218 (forward-line 1) 5219 )) 5220 mincol)) 5221 5222 (defun markdown-indent-region (beg end arg) 5223 "Indent the region from BEG to END using some heuristics. 5224 When ARG is non-nil, outdent the region instead. 5225 See `markdown-indent-line' and `markdown-indent-line'." 5226 (interactive "*r\nP") 5227 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) 5228 (leftmostcol (markdown-find-leftmost-column beg end)) 5229 (next-pos (if arg 5230 (markdown-outdent-find-next-position leftmostcol positions) 5231 (markdown-indent-find-next-position leftmostcol positions)))) 5232 (indent-rigidly beg end (- next-pos leftmostcol)) 5233 (setq deactivate-mark nil))) 5234 5235 (defun markdown-outdent-region (beg end) 5236 "Call `markdown-indent-region' on region from BEG to END with prefix." 5237 (interactive "*r") 5238 (markdown-indent-region beg end t)) 5239 5240 (defun markdown--indent-region (start end) 5241 (let ((deactivate-mark nil)) 5242 (save-excursion 5243 (goto-char end) 5244 (setq end (point-marker)) 5245 (goto-char start) 5246 (when (bolp) 5247 (forward-line 1)) 5248 (while (< (point) end) 5249 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) 5250 (indent-according-to-mode)) 5251 (forward-line 1)) 5252 (move-marker end nil)))) 5253 5254 5255 ;;; Markup Completion ========================================================= 5256 5257 (defconst markdown-complete-alist 5258 '((markdown-regex-header-atx . markdown-complete-atx) 5259 (markdown-regex-header-setext . markdown-complete-setext) 5260 (markdown-regex-hr . markdown-complete-hr)) 5261 "Association list of form (regexp . function) for markup completion.") 5262 5263 (defun markdown-incomplete-atx-p () 5264 "Return t if ATX header markup is incomplete and nil otherwise. 5265 Assumes match data is available for `markdown-regex-header-atx'. 5266 Checks that the number of trailing hash marks equals the number of leading 5267 hash marks, that there is only a single space before and after the text, 5268 and that there is no extraneous whitespace in the text." 5269 (or 5270 ;; Number of starting and ending hash marks differs 5271 (not (= (length (match-string 1)) (length (match-string 3)))) 5272 ;; When the header text is not empty... 5273 (and (> (length (match-string 2)) 0) 5274 ;; ...if there are extra leading, trailing, or interior spaces 5275 (or (not (= (match-beginning 2) (1+ (match-end 1)))) 5276 (not (= (match-beginning 3) (1+ (match-end 2)))) 5277 (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) 5278 ;; When the header text is empty... 5279 (and (= (length (match-string 2)) 0) 5280 ;; ...if there are too many or too few spaces 5281 (not (= (match-beginning 3) (+ (match-end 1) 2)))))) 5282 5283 (defun markdown-complete-atx () 5284 "Complete and normalize ATX headers. 5285 Add or remove hash marks to the end of the header to match the 5286 beginning. Ensure that there is only a single space between hash 5287 marks and header text. Removes extraneous whitespace from header text. 5288 Assumes match data is available for `markdown-regex-header-atx'. 5289 Return nil if markup was complete and non-nil if markup was completed." 5290 (when (markdown-incomplete-atx-p) 5291 (let* ((new-marker (make-marker)) 5292 (new-marker (set-marker new-marker (match-end 2)))) 5293 ;; Hash marks and spacing at end 5294 (goto-char (match-end 2)) 5295 (delete-region (match-end 2) (match-end 3)) 5296 (insert " " (match-string 1)) 5297 ;; Remove extraneous whitespace from title 5298 (replace-match (markdown-compress-whitespace-string (match-string 2)) 5299 t t nil 2) 5300 ;; Spacing at beginning 5301 (goto-char (match-end 1)) 5302 (delete-region (match-end 1) (match-beginning 2)) 5303 (insert " ") 5304 ;; Leave point at end of text 5305 (goto-char new-marker)))) 5306 5307 (defun markdown-incomplete-setext-p () 5308 "Return t if setext header markup is incomplete and nil otherwise. 5309 Assumes match data is available for `markdown-regex-header-setext'. 5310 Checks that length of underline matches text and that there is no 5311 extraneous whitespace in the text." 5312 (or (not (= (length (match-string 1)) (length (match-string 2)))) 5313 (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) 5314 5315 (defun markdown-complete-setext () 5316 "Complete and normalize setext headers. 5317 Add or remove underline characters to match length of header 5318 text. Removes extraneous whitespace from header text. Assumes 5319 match data is available for `markdown-regex-header-setext'. 5320 Return nil if markup was complete and non-nil if markup was completed." 5321 (when (markdown-incomplete-setext-p) 5322 (let* ((text (markdown-compress-whitespace-string (match-string 1))) 5323 (char (char-after (match-beginning 2))) 5324 (level (if (char-equal char ?-) 2 1))) 5325 (goto-char (match-beginning 0)) 5326 (delete-region (match-beginning 0) (match-end 0)) 5327 (markdown-insert-header level text t) 5328 t))) 5329 5330 (defun markdown-incomplete-hr-p () 5331 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. 5332 Assumes match data is available for `markdown-regex-hr'." 5333 (not (member (match-string 0) markdown-hr-strings))) 5334 5335 (defun markdown-complete-hr () 5336 "Complete horizontal rules. 5337 If horizontal rule string is a member of `markdown-hr-strings', 5338 do nothing. Otherwise, replace with the car of 5339 `markdown-hr-strings'. 5340 Assumes match data is available for `markdown-regex-hr'. 5341 Return nil if markup was complete and non-nil if markup was completed." 5342 (when (markdown-incomplete-hr-p) 5343 (replace-match (car markdown-hr-strings)) 5344 t)) 5345 5346 (defun markdown-complete () 5347 "Complete markup of object near point or in region when active. 5348 Handle all objects in `markdown-complete-alist', in order. 5349 See `markdown-complete-at-point' and `markdown-complete-region'." 5350 (interactive "*") 5351 (if (use-region-p) 5352 (markdown-complete-region (region-beginning) (region-end)) 5353 (markdown-complete-at-point))) 5354 5355 (defun markdown-complete-at-point () 5356 "Complete markup of object near point. 5357 Handle all elements of `markdown-complete-alist' in order." 5358 (interactive "*") 5359 (let ((list markdown-complete-alist) found changed) 5360 (while list 5361 (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? 5362 (function (cdar list))) 5363 (setq list (cdr list)) 5364 (when (thing-at-point-looking-at regexp) 5365 (setq found t) 5366 (setq changed (funcall function)) 5367 (setq list nil)))) 5368 (if found 5369 (or changed (user-error "Markup at point is complete")) 5370 (user-error "Nothing to complete at point")))) 5371 5372 (defun markdown-complete-region (beg end) 5373 "Complete markup of objects in region from BEG to END. 5374 Handle all objects in `markdown-complete-alist', in order. Each 5375 match is checked to ensure that a previous regexp does not also 5376 match." 5377 (interactive "*r") 5378 (let ((end-marker (set-marker (make-marker) end)) 5379 previous) 5380 (dolist (element markdown-complete-alist) 5381 (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? 5382 (function (cdr element))) 5383 (goto-char beg) 5384 (while (re-search-forward regexp end-marker 'limit) 5385 (when (match-string 0) 5386 ;; Make sure this is not a match for any of the preceding regexps. 5387 ;; This prevents mistaking an HR for a Setext subheading. 5388 (let (match) 5389 (save-match-data 5390 (dolist (prev-regexp previous) 5391 (or match (setq match (looking-back prev-regexp nil))))) 5392 (unless match 5393 (save-excursion (funcall function)))))) 5394 (cl-pushnew regexp previous :test #'equal))) 5395 previous)) 5396 5397 (defun markdown-complete-buffer () 5398 "Complete markup for all objects in the current buffer." 5399 (interactive "*") 5400 (markdown-complete-region (point-min) (point-max))) 5401 5402 5403 ;;; Markup Cycling ============================================================ 5404 5405 (defun markdown-cycle-atx (arg &optional remove) 5406 "Cycle ATX header markup. 5407 Promote header (decrease level) when ARG is 1 and demote 5408 header (increase level) if arg is -1. When REMOVE is non-nil, 5409 remove the header when the level reaches zero and stop cycling 5410 when it reaches six. Otherwise, perform a proper cycling through 5411 levels one through six. Assumes match data is available for 5412 `markdown-regex-header-atx'." 5413 (let* ((old-level (length (match-string 1))) 5414 (new-level (+ old-level arg)) 5415 (text (match-string 2))) 5416 (when (not remove) 5417 (setq new-level (% new-level 6)) 5418 (setq new-level (cond ((= new-level 0) 6) 5419 ((< new-level 0) (+ new-level 6)) 5420 (t new-level)))) 5421 (cond 5422 ((= new-level 0) 5423 (markdown-unwrap-thing-at-point nil 0 2)) 5424 ((<= new-level 6) 5425 (goto-char (match-beginning 0)) 5426 (delete-region (match-beginning 0) (match-end 0)) 5427 (markdown-insert-header new-level text nil))))) 5428 5429 (defun markdown-cycle-setext (arg &optional remove) 5430 "Cycle setext header markup. 5431 Promote header (increase level) when ARG is 1 and demote 5432 header (decrease level or remove) if arg is -1. When demoting a 5433 level-two setext header, replace with a level-three atx header. 5434 When REMOVE is non-nil, remove the header when the level reaches 5435 zero. Otherwise, cycle back to a level six atx header. Assumes 5436 match data is available for `markdown-regex-header-setext'." 5437 (let* ((char (char-after (match-beginning 2))) 5438 (old-level (if (char-equal char ?=) 1 2)) 5439 (new-level (+ old-level arg))) 5440 (when (and (not remove) (= new-level 0)) 5441 (setq new-level 6)) 5442 (cond 5443 ((= new-level 0) 5444 (markdown-unwrap-thing-at-point nil 0 1)) 5445 ((<= new-level 2) 5446 (markdown-insert-header new-level nil t)) 5447 ((<= new-level 6) 5448 (markdown-insert-header new-level nil nil))))) 5449 5450 (defun markdown-cycle-hr (arg &optional remove) 5451 "Cycle string used for horizontal rule from `markdown-hr-strings'. 5452 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle 5453 backwards (promote). When REMOVE is non-nil, remove the hr instead 5454 of cycling when the end of the list is reached. 5455 Assumes match data is available for `markdown-regex-hr'." 5456 (let* ((strings (if (= arg -1) 5457 (reverse markdown-hr-strings) 5458 markdown-hr-strings)) 5459 (tail (member (match-string 0) strings)) 5460 (new (or (cadr tail) 5461 (if remove 5462 (if (= arg 1) 5463 "" 5464 (car tail)) 5465 (car strings))))) 5466 (replace-match new))) 5467 5468 (defun markdown-cycle-bold () 5469 "Cycle bold markup between underscores and asterisks. 5470 Assumes match data is available for `markdown-regex-bold'." 5471 (save-excursion 5472 (let* ((old-delim (match-string 3)) 5473 (new-delim (if (string-equal old-delim "**") "__" "**"))) 5474 (replace-match new-delim t t nil 3) 5475 (replace-match new-delim t t nil 5)))) 5476 5477 (defun markdown-cycle-italic () 5478 "Cycle italic markup between underscores and asterisks. 5479 Assumes match data is available for `markdown-regex-italic'." 5480 (save-excursion 5481 (let* ((old-delim (match-string 2)) 5482 (new-delim (if (string-equal old-delim "*") "_" "*"))) 5483 (replace-match new-delim t t nil 2) 5484 (replace-match new-delim t t nil 4)))) 5485 5486 5487 ;;; Keymap ==================================================================== 5488 5489 (defun markdown--style-map-prompt () 5490 "Return a formatted prompt for Markdown markup insertion." 5491 (when markdown-enable-prefix-prompts 5492 (concat 5493 "Markdown: " 5494 (propertize "bold" 'face 'markdown-bold-face) ", " 5495 (propertize "italic" 'face 'markdown-italic-face) ", " 5496 (propertize "code" 'face 'markdown-inline-code-face) ", " 5497 (propertize "C = GFM code" 'face 'markdown-code-face) ", " 5498 (propertize "pre" 'face 'markdown-pre-face) ", " 5499 (propertize "footnote" 'face 'markdown-footnote-text-face) ", " 5500 (propertize "F = foldable" 'face 'markdown-bold-face) ", " 5501 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " 5502 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " 5503 (propertize "- = hr" 'face 'markdown-hr-face) ", " 5504 "C-h = more"))) 5505 5506 (defun markdown--command-map-prompt () 5507 "Return prompt for Markdown buffer-wide commands." 5508 (when markdown-enable-prefix-prompts 5509 (concat 5510 "Command: " 5511 (propertize "m" 'face 'markdown-bold-face) "arkdown, " 5512 (propertize "p" 'face 'markdown-bold-face) "review, " 5513 (propertize "o" 'face 'markdown-bold-face) "pen, " 5514 (propertize "e" 'face 'markdown-bold-face) "xport, " 5515 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " 5516 (propertize "c" 'face 'markdown-bold-face) "heck refs, " 5517 (propertize "u" 'face 'markdown-bold-face) "nused refs, " 5518 "C-h = more"))) 5519 5520 (defvar markdown-mode-style-map 5521 (let ((map (make-keymap (markdown--style-map-prompt)))) 5522 (define-key map (kbd "1") 'markdown-insert-header-atx-1) 5523 (define-key map (kbd "2") 'markdown-insert-header-atx-2) 5524 (define-key map (kbd "3") 'markdown-insert-header-atx-3) 5525 (define-key map (kbd "4") 'markdown-insert-header-atx-4) 5526 (define-key map (kbd "5") 'markdown-insert-header-atx-5) 5527 (define-key map (kbd "6") 'markdown-insert-header-atx-6) 5528 (define-key map (kbd "!") 'markdown-insert-header-setext-1) 5529 (define-key map (kbd "@") 'markdown-insert-header-setext-2) 5530 (define-key map (kbd "b") 'markdown-insert-bold) 5531 (define-key map (kbd "c") 'markdown-insert-code) 5532 (define-key map (kbd "C") 'markdown-insert-gfm-code-block) 5533 (define-key map (kbd "f") 'markdown-insert-footnote) 5534 (define-key map (kbd "F") 'markdown-insert-foldable-block) 5535 (define-key map (kbd "h") 'markdown-insert-header-dwim) 5536 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) 5537 (define-key map (kbd "i") 'markdown-insert-italic) 5538 (define-key map (kbd "k") 'markdown-insert-kbd) 5539 (define-key map (kbd "l") 'markdown-insert-link) 5540 (define-key map (kbd "p") 'markdown-insert-pre) 5541 (define-key map (kbd "P") 'markdown-pre-region) 5542 (define-key map (kbd "q") 'markdown-insert-blockquote) 5543 (define-key map (kbd "s") 'markdown-insert-strike-through) 5544 (define-key map (kbd "t") 'markdown-insert-table) 5545 (define-key map (kbd "Q") 'markdown-blockquote-region) 5546 (define-key map (kbd "w") 'markdown-insert-wiki-link) 5547 (define-key map (kbd "-") 'markdown-insert-hr) 5548 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) 5549 ;; Deprecated keys that may be removed in a future version 5550 (define-key map (kbd "e") 'markdown-insert-italic) 5551 map) 5552 "Keymap for Markdown text styling commands.") 5553 5554 (defvar markdown-mode-command-map 5555 (let ((map (make-keymap (markdown--command-map-prompt)))) 5556 (define-key map (kbd "m") 'markdown-other-window) 5557 (define-key map (kbd "p") 'markdown-preview) 5558 (define-key map (kbd "e") 'markdown-export) 5559 (define-key map (kbd "v") 'markdown-export-and-preview) 5560 (define-key map (kbd "o") 'markdown-open) 5561 (define-key map (kbd "l") 'markdown-live-preview-mode) 5562 (define-key map (kbd "w") 'markdown-kill-ring-save) 5563 (define-key map (kbd "c") 'markdown-check-refs) 5564 (define-key map (kbd "u") 'markdown-unused-refs) 5565 (define-key map (kbd "n") 'markdown-cleanup-list-numbers) 5566 (define-key map (kbd "]") 'markdown-complete-buffer) 5567 (define-key map (kbd "^") 'markdown-table-sort-lines) 5568 (define-key map (kbd "|") 'markdown-table-convert-region) 5569 (define-key map (kbd "t") 'markdown-table-transpose) 5570 map) 5571 "Keymap for Markdown buffer-wide commands.") 5572 5573 (defvar markdown-mode-map 5574 (let ((map (make-keymap))) 5575 ;; Markup insertion & removal 5576 (define-key map (kbd "C-c C-s") markdown-mode-style-map) 5577 (define-key map (kbd "C-c C-l") 'markdown-insert-link) 5578 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) 5579 ;; Promotion, demotion, and cycling 5580 (define-key map (kbd "C-c C--") 'markdown-promote) 5581 (define-key map (kbd "C-c C-=") 'markdown-demote) 5582 (define-key map (kbd "C-c C-]") 'markdown-complete) 5583 ;; Following and doing things 5584 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) 5585 (define-key map (kbd "C-c C-d") 'markdown-do) 5586 (define-key map (kbd "C-c '") 'markdown-edit-code-block) 5587 ;; Indentation 5588 (define-key map (kbd "RET") 'markdown-enter-key) 5589 (define-key map (kbd "DEL") 'markdown-outdent-or-delete) 5590 (define-key map (kbd "C-c >") 'markdown-indent-region) 5591 (define-key map (kbd "C-c <") 'markdown-outdent-region) 5592 ;; Visibility cycling 5593 (define-key map (kbd "TAB") 'markdown-cycle) 5594 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by 5595 ;; (local-)function-key-map. 5596 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) 5597 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) 5598 (define-key map (kbd "<backtab>") 'markdown-shifttab) 5599 ;; Heading and list navigation 5600 (define-key map (kbd "C-c C-n") 'markdown-outline-next) 5601 (define-key map (kbd "C-c C-p") 'markdown-outline-previous) 5602 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) 5603 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) 5604 (define-key map (kbd "C-c C-u") 'markdown-outline-up) 5605 ;; Buffer-wide commands 5606 (define-key map (kbd "C-c C-c") markdown-mode-command-map) 5607 ;; Subtree, list, and table editing 5608 (define-key map (kbd "C-c <up>") 'markdown-move-up) 5609 (define-key map (kbd "C-c <down>") 'markdown-move-down) 5610 (define-key map (kbd "C-c <left>") 'markdown-promote) 5611 (define-key map (kbd "C-c <right>") 'markdown-demote) 5612 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) 5613 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) 5614 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) 5615 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) 5616 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) 5617 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) 5618 (define-key map (kbd "M-RET") 'markdown-insert-list-item) 5619 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) 5620 ;; Lines 5621 (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) 5622 (define-key map [remap move-end-of-line] 'markdown-end-of-line) 5623 ;; Paragraphs (Markdown context aware) 5624 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) 5625 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) 5626 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) 5627 ;; Blocks (one or more paragraphs) 5628 (define-key map (kbd "C-M-{") 'markdown-backward-block) 5629 (define-key map (kbd "C-M-}") 'markdown-forward-block) 5630 (define-key map (kbd "C-c M-h") 'markdown-mark-block) 5631 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) 5632 ;; Pages (top-level sections) 5633 (define-key map [remap backward-page] 'markdown-backward-page) 5634 (define-key map [remap forward-page] 'markdown-forward-page) 5635 (define-key map [remap mark-page] 'markdown-mark-page) 5636 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) 5637 ;; Link Movement 5638 (define-key map (kbd "M-n") 'markdown-next-link) 5639 (define-key map (kbd "M-p") 'markdown-previous-link) 5640 ;; Toggling functionality 5641 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) 5642 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) 5643 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) 5644 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) 5645 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) 5646 ;; Alternative keys (in case of problems with the arrow keys) 5647 (define-key map (kbd "C-c C-x u") 'markdown-move-up) 5648 (define-key map (kbd "C-c C-x d") 'markdown-move-down) 5649 (define-key map (kbd "C-c C-x l") 'markdown-promote) 5650 (define-key map (kbd "C-c C-x r") 'markdown-demote) 5651 ;; Deprecated keys that may be removed in a future version 5652 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l 5653 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l 5654 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l 5655 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l 5656 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) 5657 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) 5658 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) 5659 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) 5660 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) 5661 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) 5662 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) 5663 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) 5664 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) 5665 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) 5666 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) 5667 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) 5668 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) 5669 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) 5670 (define-key map (kbd "C-c C-i") 'markdown-insert-image) 5671 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j 5672 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d 5673 (define-key map (kbd "C-c -") 'markdown-insert-hr) 5674 map) 5675 "Keymap for Markdown major mode.") 5676 5677 (defvar markdown-mode-mouse-map 5678 (when markdown-mouse-follow-link 5679 (let ((map (make-sparse-keymap))) 5680 (define-key map [follow-link] 'mouse-face) 5681 (define-key map [mouse-2] #'markdown-follow-thing-at-point) 5682 map)) 5683 "Keymap for following links with mouse.") 5684 5685 (defvar gfm-mode-map 5686 (let ((map (make-sparse-keymap))) 5687 (set-keymap-parent map markdown-mode-map) 5688 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) 5689 (define-key map "`" 'markdown-electric-backquote) 5690 map) 5691 "Keymap for `gfm-mode'. 5692 See also `markdown-mode-map'.") 5693 5694 5695 ;;; Menu ====================================================================== 5696 5697 (easy-menu-define markdown-mode-menu markdown-mode-map 5698 "Menu for Markdown mode." 5699 '("Markdown" 5700 "---" 5701 ("Movement" 5702 ["Jump" markdown-do] 5703 ["Follow Link" markdown-follow-thing-at-point] 5704 ["Next Link" markdown-next-link] 5705 ["Previous Link" markdown-previous-link] 5706 "---" 5707 ["Next Heading or List Item" markdown-outline-next] 5708 ["Previous Heading or List Item" markdown-outline-previous] 5709 ["Next at Same Level" markdown-outline-next-same-level] 5710 ["Previous at Same Level" markdown-outline-previous-same-level] 5711 ["Up to Parent" markdown-outline-up] 5712 "---" 5713 ["Forward Paragraph" markdown-forward-paragraph] 5714 ["Backward Paragraph" markdown-backward-paragraph] 5715 ["Forward Block" markdown-forward-block] 5716 ["Backward Block" markdown-backward-block]) 5717 ("Show & Hide" 5718 ["Cycle Heading Visibility" markdown-cycle 5719 :enable (markdown-on-heading-p)] 5720 ["Cycle Heading Visibility (Global)" markdown-shifttab] 5721 "---" 5722 ["Narrow to Region" narrow-to-region] 5723 ["Narrow to Block" markdown-narrow-to-block] 5724 ["Narrow to Section" narrow-to-defun] 5725 ["Narrow to Subtree" markdown-narrow-to-subtree] 5726 ["Widen" widen (buffer-narrowed-p)] 5727 "---" 5728 ["Toggle Markup Hiding" markdown-toggle-markup-hiding 5729 :keys "C-c C-x C-m" 5730 :style radio 5731 :selected markdown-hide-markup]) 5732 "---" 5733 ("Headings & Structure" 5734 ["Automatic Heading" markdown-insert-header-dwim 5735 :keys "C-c C-s h"] 5736 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim 5737 :keys "C-c C-s H"] 5738 ("Specific Heading (atx)" 5739 ["First Level atx" markdown-insert-header-atx-1 5740 :keys "C-c C-s 1"] 5741 ["Second Level atx" markdown-insert-header-atx-2 5742 :keys "C-c C-s 2"] 5743 ["Third Level atx" markdown-insert-header-atx-3 5744 :keys "C-c C-s 3"] 5745 ["Fourth Level atx" markdown-insert-header-atx-4 5746 :keys "C-c C-s 4"] 5747 ["Fifth Level atx" markdown-insert-header-atx-5 5748 :keys "C-c C-s 5"] 5749 ["Sixth Level atx" markdown-insert-header-atx-6 5750 :keys "C-c C-s 6"]) 5751 ("Specific Heading (Setext)" 5752 ["First Level Setext" markdown-insert-header-setext-1 5753 :keys "C-c C-s !"] 5754 ["Second Level Setext" markdown-insert-header-setext-2 5755 :keys "C-c C-s @"]) 5756 ["Horizontal Rule" markdown-insert-hr 5757 :keys "C-c C-s -"] 5758 "---" 5759 ["Move Subtree Up" markdown-move-up 5760 :keys "C-c <up>"] 5761 ["Move Subtree Down" markdown-move-down 5762 :keys "C-c <down>"] 5763 ["Promote Subtree" markdown-promote 5764 :keys "C-c <left>"] 5765 ["Demote Subtree" markdown-demote 5766 :keys "C-c <right>"]) 5767 ("Region & Mark" 5768 ["Indent Region" markdown-indent-region] 5769 ["Outdent Region" markdown-outdent-region] 5770 "--" 5771 ["Mark Paragraph" mark-paragraph] 5772 ["Mark Block" markdown-mark-block] 5773 ["Mark Section" mark-defun] 5774 ["Mark Subtree" markdown-mark-subtree]) 5775 ("Tables" 5776 ["Move Row Up" markdown-move-up 5777 :enable (markdown-table-at-point-p) 5778 :keys "C-c <up>"] 5779 ["Move Row Down" markdown-move-down 5780 :enable (markdown-table-at-point-p) 5781 :keys "C-c <down>"] 5782 ["Move Column Left" markdown-promote 5783 :enable (markdown-table-at-point-p) 5784 :keys "C-c <left>"] 5785 ["Move Column Right" markdown-demote 5786 :enable (markdown-table-at-point-p) 5787 :keys "C-c <right>"] 5788 ["Delete Row" markdown-table-delete-row 5789 :enable (markdown-table-at-point-p)] 5790 ["Insert Row" markdown-table-insert-row 5791 :enable (markdown-table-at-point-p)] 5792 ["Delete Column" markdown-table-delete-column 5793 :enable (markdown-table-at-point-p)] 5794 ["Insert Column" markdown-table-insert-column 5795 :enable (markdown-table-at-point-p)] 5796 ["Insert Table" markdown-insert-table] 5797 "--" 5798 ["Convert Region to Table" markdown-table-convert-region] 5799 ["Sort Table Lines" markdown-table-sort-lines 5800 :enable (markdown-table-at-point-p)] 5801 ["Transpose Table" markdown-table-transpose 5802 :enable (markdown-table-at-point-p)]) 5803 ("Lists" 5804 ["Insert List Item" markdown-insert-list-item] 5805 ["Move Subtree Up" markdown-move-up 5806 :keys "C-c <up>"] 5807 ["Move Subtree Down" markdown-move-down 5808 :keys "C-c <down>"] 5809 ["Indent Subtree" markdown-demote 5810 :keys "C-c <right>"] 5811 ["Outdent Subtree" markdown-promote 5812 :keys "C-c <left>"] 5813 ["Renumber List" markdown-cleanup-list-numbers] 5814 ["Insert Task List Item" markdown-insert-gfm-checkbox 5815 :keys "C-c C-x ["] 5816 ["Toggle Task List Item" markdown-toggle-gfm-checkbox 5817 :enable (markdown-gfm-task-list-item-at-point) 5818 :keys "C-c C-d"]) 5819 ("Links & Images" 5820 ["Insert Link" markdown-insert-link] 5821 ["Insert Image" markdown-insert-image] 5822 ["Insert Footnote" markdown-insert-footnote 5823 :keys "C-c C-s f"] 5824 ["Insert Wiki Link" markdown-insert-wiki-link 5825 :keys "C-c C-s w"] 5826 "---" 5827 ["Check References" markdown-check-refs] 5828 ["Find Unused References" markdown-unused-refs] 5829 ["Toggle URL Hiding" markdown-toggle-url-hiding 5830 :style radio 5831 :selected markdown-hide-urls] 5832 ["Toggle Inline Images" markdown-toggle-inline-images 5833 :keys "C-c C-x C-i" 5834 :style radio 5835 :selected markdown-inline-image-overlays] 5836 ["Toggle Wiki Links" markdown-toggle-wiki-links 5837 :style radio 5838 :selected markdown-enable-wiki-links]) 5839 ("Styles" 5840 ["Bold" markdown-insert-bold] 5841 ["Italic" markdown-insert-italic] 5842 ["Code" markdown-insert-code] 5843 ["Strikethrough" markdown-insert-strike-through] 5844 ["Keyboard" markdown-insert-kbd] 5845 "---" 5846 ["Blockquote" markdown-insert-blockquote] 5847 ["Preformatted" markdown-insert-pre] 5848 ["GFM Code Block" markdown-insert-gfm-code-block] 5849 ["Edit Code Block" markdown-edit-code-block 5850 :enable (markdown-code-block-at-point-p)] 5851 ["Foldable Block" markdown-insert-foldable-block] 5852 "---" 5853 ["Blockquote Region" markdown-blockquote-region] 5854 ["Preformatted Region" markdown-pre-region] 5855 "---" 5856 ["Fontify Code Blocks Natively" 5857 markdown-toggle-fontify-code-blocks-natively 5858 :style radio 5859 :selected markdown-fontify-code-blocks-natively] 5860 ["LaTeX Math Support" markdown-toggle-math 5861 :style radio 5862 :selected markdown-enable-math]) 5863 "---" 5864 ("Preview & Export" 5865 ["Compile" markdown-other-window] 5866 ["Preview" markdown-preview] 5867 ["Export" markdown-export] 5868 ["Export & View" markdown-export-and-preview] 5869 ["Open" markdown-open] 5870 ["Live Export" markdown-live-preview-mode 5871 :style radio 5872 :selected markdown-live-preview-mode] 5873 ["Kill ring save" markdown-kill-ring-save]) 5874 ("Markup Completion and Cycling" 5875 ["Complete Markup" markdown-complete] 5876 ["Promote Element" markdown-promote 5877 :keys "C-c C--"] 5878 ["Demote Element" markdown-demote 5879 :keys "C-c C-="]) 5880 "---" 5881 ["Kill Element" markdown-kill-thing-at-point] 5882 "---" 5883 ("Documentation" 5884 ["Version" markdown-show-version] 5885 ["Homepage" markdown-mode-info] 5886 ["Describe Mode" (describe-function 'markdown-mode)] 5887 ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) 5888 5889 5890 ;;; imenu ===================================================================== 5891 5892 (defun markdown-imenu-create-nested-index () 5893 "Create and return a nested imenu index alist for the current buffer. 5894 See `imenu-create-index-function' and `imenu--index-alist' for details." 5895 (let* ((root (list nil)) 5896 (min-level 9999) 5897 hashes headers) 5898 (save-excursion 5899 ;; Headings 5900 (goto-char (point-min)) 5901 (while (re-search-forward markdown-regex-header (point-max) t) 5902 (unless (or (markdown-code-block-at-point-p) 5903 (and (match-beginning 3) 5904 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) 5905 (cond 5906 ((match-string-no-properties 2) ;; level 1 setext 5907 (setq min-level 1) 5908 (push (list :heading (match-string-no-properties 1) 5909 :point (match-beginning 1) 5910 :level 1) headers)) 5911 ((match-string-no-properties 3) ;; level 2 setext 5912 (setq min-level (min min-level 2)) 5913 (push (list :heading (match-string-no-properties 1) 5914 :point (match-beginning 1) 5915 :level (- 2 (1- min-level))) headers)) 5916 ((setq hashes (markdown-trim-whitespace 5917 (match-string-no-properties 4))) 5918 (setq min-level (min min-level (length hashes))) 5919 (push (list :heading (match-string-no-properties 5) 5920 :point (match-beginning 4) 5921 :level (- (length hashes) (1- min-level))) headers))))) 5922 (cl-loop with cur-level = 0 5923 with cur-alist = nil 5924 with empty-heading = "-" 5925 with self-heading = "." 5926 for header in (reverse headers) 5927 for level = (plist-get header :level) 5928 do 5929 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) 5930 (cond 5931 ((= cur-level level) ; new sibling 5932 (setcdr cur-alist alist) 5933 (setq cur-alist alist)) 5934 ((< cur-level level) ; first child 5935 (dotimes (_ (- level cur-level 1)) 5936 (setq alist (list (cons empty-heading alist)))) 5937 (if cur-alist 5938 (let* ((parent (car cur-alist)) 5939 (self-pos (cdr parent))) 5940 (setcdr parent (cons (cons self-heading self-pos) alist))) 5941 (setcdr root alist)) ; primogenitor 5942 (setq cur-alist alist) 5943 (setq cur-level level)) 5944 (t ; new sibling of an ancestor 5945 (let ((sibling-alist (last (cdr root)))) 5946 (dotimes (_ (1- level)) 5947 (setq sibling-alist (last (cdar sibling-alist)))) 5948 (setcdr sibling-alist alist) 5949 (setq cur-alist alist)) 5950 (setq cur-level level))))) 5951 (setq root (copy-tree root)) 5952 ;; Footnotes 5953 (let ((fn (markdown-get-defined-footnotes))) 5954 (if (or (zerop (length fn)) 5955 (null markdown-add-footnotes-to-imenu)) 5956 (cdr root) 5957 (nconc (cdr root) (list (cons "Footnotes" fn)))))))) 5958 5959 (defun markdown-imenu-create-flat-index () 5960 "Create and return a flat imenu index alist for the current buffer. 5961 See `imenu-create-index-function' and `imenu--index-alist' for details." 5962 (let* ((empty-heading "-") index heading pos) 5963 (save-excursion 5964 ;; Headings 5965 (goto-char (point-min)) 5966 (while (re-search-forward markdown-regex-header (point-max) t) 5967 (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) 5968 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) 5969 (cond 5970 ((setq heading (match-string-no-properties 1)) 5971 (setq pos (match-beginning 1))) 5972 ((setq heading (match-string-no-properties 5)) 5973 (setq pos (match-beginning 4)))) 5974 (or (> (length heading) 0) 5975 (setq heading empty-heading)) 5976 (setq index (append index (list (cons heading pos)))))) 5977 ;; Footnotes 5978 (when markdown-add-footnotes-to-imenu 5979 (nconc index (markdown-get-defined-footnotes))) 5980 index))) 5981 5982 5983 ;;; References ================================================================ 5984 5985 (defun markdown-reference-goto-definition () 5986 "Jump to the definition of the reference at point or create it." 5987 (interactive) 5988 (when (thing-at-point-looking-at markdown-regex-link-reference) 5989 (let* ((text (match-string-no-properties 3)) 5990 (reference (match-string-no-properties 6)) 5991 (target (downcase (if (string= reference "") text reference))) 5992 (loc (cadr (save-match-data (markdown-reference-definition target))))) 5993 (if loc 5994 (goto-char loc) 5995 (goto-char (match-beginning 0)) 5996 (markdown-insert-reference-definition target))))) 5997 5998 (defun markdown-reference-find-links (reference) 5999 "Return a list of all links for REFERENCE. 6000 REFERENCE should not include the surrounding square brackets. 6001 Elements of the list have the form (text start line), where 6002 text is the link text, start is the location at the beginning of 6003 the link, and line is the line number on which the link appears." 6004 (let* ((ref-quote (regexp-quote reference)) 6005 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" 6006 ref-quote ref-quote)) 6007 links) 6008 (save-excursion 6009 (goto-char (point-min)) 6010 (while (re-search-forward regexp nil t) 6011 (let* ((text (or (match-string-no-properties 1) 6012 (match-string-no-properties 2))) 6013 (start (match-beginning 0)) 6014 (line (markdown-line-number-at-pos))) 6015 (cl-pushnew (list text start line) links :test #'equal)))) 6016 links)) 6017 6018 (defmacro markdown-for-all-refs (f) 6019 `(let ((result)) 6020 (save-excursion 6021 (goto-char (point-min)) 6022 (while 6023 (re-search-forward markdown-regex-link-reference nil t) 6024 (let* ((text (match-string-no-properties 3)) 6025 (reference (match-string-no-properties 6)) 6026 (target (downcase (if (string= reference "") text reference)))) 6027 (,f text target result)))) 6028 (reverse result))) 6029 6030 (defmacro markdown-collect-always (_ target result) 6031 `(cl-pushnew ,target ,result :test #'equal)) 6032 6033 (defmacro markdown-collect-undefined (text target result) 6034 `(unless (markdown-reference-definition target) 6035 (let ((entry (assoc ,target ,result))) 6036 (if (not entry) 6037 (cl-pushnew 6038 (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) 6039 ,result :test #'equal) 6040 (setcdr entry 6041 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) 6042 6043 (defun markdown-get-all-refs () 6044 "Return a list of all Markdown references." 6045 (markdown-for-all-refs markdown-collect-always)) 6046 6047 (defun markdown-get-undefined-refs () 6048 "Return a list of undefined Markdown references. 6049 Result is an alist of pairs (reference . occurrences), where 6050 occurrences is itself another alist of pairs (label . line-number). 6051 For example, an alist corresponding to [Nice editor][Emacs] at line 12, 6052 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is 6053 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." 6054 (markdown-for-all-refs markdown-collect-undefined)) 6055 6056 (defun markdown-get-unused-refs () 6057 (cl-sort 6058 (cl-set-difference 6059 (markdown-get-defined-references) (markdown-get-all-refs) 6060 :test (lambda (e1 e2) (equal (car e1) e2))) 6061 #'< :key #'cdr)) 6062 6063 (defmacro defun-markdown-buffer (name docstring) 6064 "Define a function to name and return a buffer. 6065 6066 By convention, NAME must be a name of a string constant with 6067 %buffer% placeholder used to name the buffer, and will also be 6068 used as a name of the function defined. 6069 6070 DOCSTRING will be used as the first part of the docstring." 6071 `(defun ,name (&optional buffer-name) 6072 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") 6073 (or buffer-name (setq buffer-name (buffer-name))) 6074 (let ((refbuf (get-buffer-create (replace-regexp-in-string 6075 "%buffer%" buffer-name 6076 ,name)))) 6077 (with-current-buffer refbuf 6078 (when view-mode 6079 (View-exit-and-edit)) 6080 (use-local-map button-buffer-map) 6081 (erase-buffer)) 6082 refbuf))) 6083 6084 (defconst markdown-reference-check-buffer 6085 "*Undefined references for %buffer%*" 6086 "Pattern for name of buffer for listing undefined references. 6087 The string %buffer% will be replaced by the corresponding 6088 `markdown-mode' buffer name.") 6089 6090 (defun-markdown-buffer 6091 markdown-reference-check-buffer 6092 "Name and return buffer for reference checking.") 6093 6094 (defconst markdown-unused-references-buffer 6095 "*Unused references for %buffer%*" 6096 "Pattern for name of buffer for listing unused references. 6097 The string %buffer% will be replaced by the corresponding 6098 `markdown-mode' buffer name.") 6099 6100 (defun-markdown-buffer 6101 markdown-unused-references-buffer 6102 "Name and return buffer for unused reference checking.") 6103 6104 (defconst markdown-reference-links-buffer 6105 "*Reference links for %buffer%*" 6106 "Pattern for name of buffer for listing references. 6107 The string %buffer% will be replaced by the corresponding buffer name.") 6108 6109 (defun-markdown-buffer 6110 markdown-reference-links-buffer 6111 "Name, setup, and return a buffer for listing links.") 6112 6113 ;; Add an empty Markdown reference definition to buffer 6114 ;; specified in the 'target-buffer property. The reference name is 6115 ;; the button's label. 6116 (define-button-type 'markdown-undefined-reference-button 6117 'help-echo "mouse-1, RET: create definition for undefined reference" 6118 'follow-link t 6119 'face 'bold 6120 'action (lambda (b) 6121 (let ((buffer (button-get b 'target-buffer)) 6122 (line (button-get b 'target-line)) 6123 (label (button-label b))) 6124 (switch-to-buffer-other-window buffer) 6125 (goto-char (point-min)) 6126 (forward-line line) 6127 (markdown-insert-reference-definition label) 6128 (markdown-check-refs t)))) 6129 6130 ;; Jump to line in buffer specified by 'target-buffer property. 6131 ;; Line number is button's 'target-line property. 6132 (define-button-type 'markdown-goto-line-button 6133 'help-echo "mouse-1, RET: go to line" 6134 'follow-link t 6135 'face 'italic 6136 'action (lambda (b) 6137 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6138 ;; use call-interactively to silence compiler 6139 (let ((current-prefix-arg (button-get b 'target-line))) 6140 (call-interactively 'goto-line)))) 6141 6142 ;; Kill a line in buffer specified by 'target-buffer property. 6143 ;; Line number is button's 'target-line property. 6144 (define-button-type 'markdown-kill-line-button 6145 'help-echo "mouse-1, RET: kill line" 6146 'follow-link t 6147 'face 'italic 6148 'action (lambda (b) 6149 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6150 ;; use call-interactively to silence compiler 6151 (let ((current-prefix-arg (button-get b 'target-line))) 6152 (call-interactively 'goto-line)) 6153 (kill-line 1) 6154 (markdown-unused-refs t))) 6155 6156 ;; Jumps to a particular link at location given by 'target-char 6157 ;; property in buffer given by 'target-buffer property. 6158 (define-button-type 'markdown-location-button 6159 'help-echo "mouse-1, RET: jump to location of link" 6160 'follow-link t 6161 'face 'bold 6162 'action (lambda (b) 6163 (let ((target (button-get b 'target-buffer)) 6164 (loc (button-get b 'target-char))) 6165 (kill-buffer-and-window) 6166 (switch-to-buffer target) 6167 (goto-char loc)))) 6168 6169 (defun markdown-insert-undefined-reference-button (reference oldbuf) 6170 "Insert a button for creating REFERENCE in buffer OLDBUF. 6171 REFERENCE should be a list of the form (reference . occurrences), 6172 as returned by `markdown-get-undefined-refs'." 6173 (let ((label (car reference))) 6174 ;; Create a reference button 6175 (insert-button label 6176 :type 'markdown-undefined-reference-button 6177 'target-buffer oldbuf 6178 'target-line (cdr (car (cdr reference)))) 6179 (insert " (") 6180 (dolist (occurrence (cdr reference)) 6181 (let ((line (cdr occurrence))) 6182 ;; Create a line number button 6183 (insert-button (number-to-string line) 6184 :type 'markdown-goto-line-button 6185 'target-buffer oldbuf 6186 'target-line line) 6187 (insert " "))) 6188 (delete-char -1) 6189 (insert ")") 6190 (newline))) 6191 6192 (defun markdown-insert-unused-reference-button (reference oldbuf) 6193 "Insert a button for creating REFERENCE in buffer OLDBUF. 6194 REFERENCE must be a pair of (ref . line-number)." 6195 (let ((label (car reference)) 6196 (line (cdr reference))) 6197 ;; Create a reference button 6198 (insert-button label 6199 :type 'markdown-goto-line-button 6200 'face 'bold 6201 'target-buffer oldbuf 6202 'target-line line) 6203 (insert (format " (%d) [" line)) 6204 (insert-button "X" 6205 :type 'markdown-kill-line-button 6206 'face 'bold 6207 'target-buffer oldbuf 6208 'target-line line) 6209 (insert "]") 6210 (newline))) 6211 6212 (defun markdown-insert-link-button (link oldbuf) 6213 "Insert a button for jumping to LINK in buffer OLDBUF. 6214 LINK should be a list of the form (text char line) containing 6215 the link text, location, and line number." 6216 (let ((label (cl-first link)) 6217 (char (cl-second link)) 6218 (line (cl-third link))) 6219 ;; Create a reference button 6220 (insert-button label 6221 :type 'markdown-location-button 6222 'target-buffer oldbuf 6223 'target-char char) 6224 (insert (format " (line %d)\n" line)))) 6225 6226 (defun markdown-reference-goto-link (&optional reference) 6227 "Jump to the location of the first use of REFERENCE." 6228 (interactive) 6229 (unless reference 6230 (if (thing-at-point-looking-at markdown-regex-reference-definition) 6231 (setq reference (match-string-no-properties 2)) 6232 (user-error "No reference definition at point"))) 6233 (let ((links (markdown-reference-find-links reference))) 6234 (cond ((= (length links) 1) 6235 (goto-char (cadr (car links)))) 6236 ((> (length links) 1) 6237 (let ((oldbuf (current-buffer)) 6238 (linkbuf (markdown-reference-links-buffer))) 6239 (with-current-buffer linkbuf 6240 (insert "Links using reference " reference ":\n\n") 6241 (dolist (link (reverse links)) 6242 (markdown-insert-link-button link oldbuf))) 6243 (view-buffer-other-window linkbuf) 6244 (goto-char (point-min)) 6245 (forward-line 2))) 6246 (t 6247 (error "No links for reference %s" reference))))) 6248 6249 (defmacro defun-markdown-ref-checker 6250 (name docstring checker-function buffer-function none-message buffer-header insert-reference) 6251 "Define a function NAME acting on result of CHECKER-FUNCTION. 6252 6253 DOCSTRING is used as a docstring for the defined function. 6254 6255 BUFFER-FUNCTION should name and return an auxiliary buffer to put 6256 results in. 6257 6258 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. 6259 6260 BUFFER-HEADER is put into the auxiliary buffer first, followed by 6261 calling INSERT-REFERENCE for each element in the list returned by 6262 CHECKER-FUNCTION." 6263 `(defun ,name (&optional silent) 6264 ,(concat 6265 docstring 6266 "\n\nIf SILENT is non-nil, do not message anything when no 6267 such references found.") 6268 (interactive "P") 6269 (unless (derived-mode-p 'markdown-mode) 6270 (user-error "Not available in current mode")) 6271 (let ((oldbuf (current-buffer)) 6272 (refs (,checker-function)) 6273 (refbuf (,buffer-function))) 6274 (if (null refs) 6275 (progn 6276 (when (not silent) 6277 (message ,none-message)) 6278 (kill-buffer refbuf)) 6279 (with-current-buffer refbuf 6280 (insert ,buffer-header) 6281 (dolist (ref refs) 6282 (,insert-reference ref oldbuf)) 6283 (view-buffer-other-window refbuf) 6284 (goto-char (point-min)) 6285 (forward-line 2)))))) 6286 6287 (defun-markdown-ref-checker 6288 markdown-check-refs 6289 "Show all undefined Markdown references in current `markdown-mode' buffer. 6290 6291 Links which have empty reference definitions are considered to be 6292 defined." 6293 markdown-get-undefined-refs 6294 markdown-reference-check-buffer 6295 "No undefined references found" 6296 "The following references are undefined:\n\n" 6297 markdown-insert-undefined-reference-button) 6298 6299 6300 (defun-markdown-ref-checker 6301 markdown-unused-refs 6302 "Show all unused Markdown references in current `markdown-mode' buffer." 6303 markdown-get-unused-refs 6304 markdown-unused-references-buffer 6305 "No unused references found" 6306 "The following references are unused:\n\n" 6307 markdown-insert-unused-reference-button) 6308 6309 6310 6311 ;;; Lists ===================================================================== 6312 6313 (defun markdown-insert-list-item (&optional arg) 6314 "Insert a new list item. 6315 If the point is inside unordered list, insert a bullet mark. If 6316 the point is inside ordered list, insert the next number followed 6317 by a period. Use the previous list item to determine the amount 6318 of whitespace to place before and after list markers. 6319 6320 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 6321 decrease the indentation by one level. 6322 6323 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 6324 increase the indentation by one level." 6325 (interactive "p") 6326 (let (bounds cur-indent marker indent new-indent new-loc) 6327 (save-match-data 6328 ;; Look for a list item on current or previous non-blank line 6329 (save-excursion 6330 (while (and (not (setq bounds (markdown-cur-list-item-bounds))) 6331 (not (bobp)) 6332 (markdown-cur-line-blank-p)) 6333 (forward-line -1))) 6334 (when bounds 6335 (cond ((save-excursion 6336 (skip-chars-backward " \t") 6337 (looking-at-p markdown-regex-list)) 6338 (beginning-of-line) 6339 (insert "\n") 6340 (forward-line -1)) 6341 ((not (markdown-cur-line-blank-p)) 6342 (newline))) 6343 (setq new-loc (point))) 6344 ;; Look ahead for a list item on next non-blank line 6345 (unless bounds 6346 (save-excursion 6347 (while (and (null bounds) 6348 (not (eobp)) 6349 (markdown-cur-line-blank-p)) 6350 (forward-line) 6351 (setq bounds (markdown-cur-list-item-bounds)))) 6352 (when bounds 6353 (setq new-loc (point)) 6354 (unless (markdown-cur-line-blank-p) 6355 (newline)))) 6356 (if (not bounds) 6357 ;; When not in a list, start a new unordered one 6358 (progn 6359 (unless (markdown-cur-line-blank-p) 6360 (insert "\n")) 6361 (insert markdown-unordered-list-item-prefix)) 6362 ;; Compute indentation and marker for new list item 6363 (setq cur-indent (nth 2 bounds)) 6364 (setq marker (nth 4 bounds)) 6365 ;; If current item is a GFM checkbox, insert new unchecked checkbox. 6366 (when (nth 5 bounds) 6367 (setq marker 6368 (concat marker 6369 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) 6370 (cond 6371 ;; Dedent: decrement indentation, find previous marker. 6372 ((= arg 4) 6373 (setq indent (max (- cur-indent markdown-list-indent-width) 0)) 6374 (let ((prev-bounds 6375 (save-excursion 6376 (goto-char (nth 0 bounds)) 6377 (when (markdown-up-list) 6378 (markdown-cur-list-item-bounds))))) 6379 (when prev-bounds 6380 (setq marker (nth 4 prev-bounds))))) 6381 ;; Indent: increment indentation by 4, use same marker. 6382 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) 6383 ;; Same level: keep current indentation and marker. 6384 (t (setq indent cur-indent))) 6385 (setq new-indent (make-string indent 32)) 6386 (goto-char new-loc) 6387 (cond 6388 ;; Ordered list 6389 ((string-match-p "[0-9]" marker) 6390 (if (= arg 16) ;; starting a new column indented one more level 6391 (insert (concat new-indent "1. ")) 6392 ;; Don't use previous match-data 6393 (set-match-data nil) 6394 ;; travel up to the last item and pick the correct number. If 6395 ;; the argument was nil, "new-indent = cur-indent" is the same, 6396 ;; so we don't need special treatment. Neat. 6397 (save-excursion 6398 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) 6399 (>= (forward-line -1) 0)))) 6400 (let* ((old-prefix (match-string 1)) 6401 (old-spacing (match-string 2)) 6402 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) 6403 (int-to-string (1+ (string-to-number old-prefix))) 6404 "1")) 6405 (space-adjust (- (length old-prefix) (length new-prefix))) 6406 (new-spacing (if (and (match-string 2) 6407 (not (string-match-p "\t" old-spacing)) 6408 (< space-adjust 0) 6409 (> space-adjust (- 1 (length (match-string 2))))) 6410 (substring (match-string 2) 0 space-adjust) 6411 (or old-spacing ". ")))) 6412 (insert (concat new-indent new-prefix new-spacing))))) 6413 ;; Unordered list, GFM task list, or ordered list with hash mark 6414 ((string-match-p "[\\*\\+-]\\|#\\." marker) 6415 (insert new-indent marker)))) 6416 ;; Propertize the newly inserted list item now 6417 (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) 6418 6419 (defun markdown-move-list-item-up () 6420 "Move the current list item up in the list when possible. 6421 In nested lists, move child items with the parent item." 6422 (interactive) 6423 (let (cur prev old) 6424 (when (setq cur (markdown-cur-list-item-bounds)) 6425 (setq old (point)) 6426 (goto-char (nth 0 cur)) 6427 (if (markdown-prev-list-item (nth 3 cur)) 6428 (progn 6429 (setq prev (markdown-cur-list-item-bounds)) 6430 (condition-case nil 6431 (progn 6432 (transpose-regions (nth 0 prev) (nth 1 prev) 6433 (nth 0 cur) (nth 1 cur) t) 6434 (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) 6435 ;; Catch error in case regions overlap. 6436 (error (goto-char old)))) 6437 (goto-char old))))) 6438 6439 (defun markdown-move-list-item-down () 6440 "Move the current list item down in the list when possible. 6441 In nested lists, move child items with the parent item." 6442 (interactive) 6443 (let (cur next old) 6444 (when (setq cur (markdown-cur-list-item-bounds)) 6445 (setq old (point)) 6446 (if (markdown-next-list-item (nth 3 cur)) 6447 (progn 6448 (setq next (markdown-cur-list-item-bounds)) 6449 (condition-case nil 6450 (progn 6451 (transpose-regions (nth 0 cur) (nth 1 cur) 6452 (nth 0 next) (nth 1 next) nil) 6453 (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) 6454 ;; Catch error in case regions overlap. 6455 (error (goto-char old)))) 6456 (goto-char old))))) 6457 6458 (defun markdown-demote-list-item (&optional bounds) 6459 "Indent (or demote) the current list item. 6460 Optionally, BOUNDS of the current list item may be provided if available. 6461 In nested lists, demote child items as well." 6462 (interactive) 6463 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6464 (save-excursion 6465 (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) 6466 (item-end (set-marker (make-marker) (nth 1 bounds))) 6467 (list-start (progn (markdown-beginning-of-list) 6468 (set-marker (make-marker) (point)))) 6469 (list-end (progn (markdown-end-of-list) 6470 (set-marker (make-marker) (point))))) 6471 (goto-char item-start) 6472 (while (< (point) item-end) 6473 (unless (markdown-cur-line-blank-p) 6474 (insert (make-string markdown-list-indent-width ? ))) 6475 (forward-line)) 6476 (markdown-syntax-propertize-list-items list-start list-end))))) 6477 6478 (defun markdown-promote-list-item (&optional bounds) 6479 "Unindent (or promote) the current list item. 6480 Optionally, BOUNDS of the current list item may be provided if available. 6481 In nested lists, demote child items as well." 6482 (interactive) 6483 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6484 (save-excursion 6485 (save-match-data 6486 (let ((item-start (set-marker (make-marker) (nth 0 bounds))) 6487 (item-end (set-marker (make-marker) (nth 1 bounds))) 6488 (list-start (progn (markdown-beginning-of-list) 6489 (set-marker (make-marker) (point)))) 6490 (list-end (progn (markdown-end-of-list) 6491 (set-marker (make-marker) (point)))) 6492 num regexp) 6493 (goto-char item-start) 6494 (when (looking-at (format "^[ ]\\{1,%d\\}" 6495 markdown-list-indent-width)) 6496 (setq num (- (match-end 0) (match-beginning 0))) 6497 (setq regexp (format "^[ ]\\{1,%d\\}" num)) 6498 (while (and (< (point) item-end) 6499 (re-search-forward regexp item-end t)) 6500 (replace-match "" nil nil) 6501 (forward-line)) 6502 (markdown-syntax-propertize-list-items list-start list-end))))))) 6503 6504 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) 6505 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. 6506 PREV-ITEM is width of previous-indentation and list number 6507 6508 Assume that the previously found match was for a numbered item in 6509 a list." 6510 (let ((cpfx pfx) 6511 (cur-item nil) 6512 (idx 0) 6513 (continue t) 6514 (step t) 6515 (sep nil)) 6516 (while (and continue (not (eobp))) 6517 (setq step t) 6518 (cond 6519 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") 6520 (setq cpfx (match-string-no-properties 2)) 6521 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker 6522 (cond 6523 ((or (= (length cpfx) (length pfx)) 6524 (= (length cur-item) (length prev-item))) 6525 (save-excursion 6526 (replace-match 6527 (if (not markdown-ordered-list-enumeration) 6528 (concat pfx "1. ") 6529 (cl-incf idx) 6530 (concat pfx (number-to-string idx) ". ")))) 6531 (setq sep nil)) 6532 ;; indented a level 6533 ((< (length pfx) (length cpfx)) 6534 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) 6535 (setq step nil)) 6536 ;; exit the loop 6537 (t 6538 (setq step nil) 6539 (setq continue nil)))) 6540 6541 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") 6542 (setq cpfx (match-string-no-properties 1)) 6543 (cond 6544 ;; reset if separated before 6545 ((string= cpfx pfx) (when sep (setq idx 0))) 6546 ((string< cpfx pfx) 6547 (setq step nil) 6548 (setq continue nil)))) 6549 (t (setq sep t))) 6550 6551 (when step 6552 (beginning-of-line) 6553 (setq continue (= (forward-line) 0)))) 6554 sep)) 6555 6556 (defun markdown-cleanup-list-numbers () 6557 "Update the numbering of ordered lists." 6558 (interactive) 6559 (save-excursion 6560 (goto-char (point-min)) 6561 (markdown-cleanup-list-numbers-level ""))) 6562 6563 6564 ;;; Movement ================================================================== 6565 6566 ;; This function was originally derived from `org-beginning-of-line' from org.el. 6567 (defun markdown-beginning-of-line (&optional n) 6568 "Go to the beginning of the current visible line. 6569 6570 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6571 or symbol `reversed', on the first attempt move to where the 6572 headline text hashes, and only move to beginning of line when the 6573 cursor is already before the hashes of the text of the headline. 6574 6575 If `markdown-special-ctrl-a/e' is symbol `reversed' then go to 6576 the hashes of the text on the second attempt. 6577 6578 With argument N not nil or 1, move forward N - 1 lines first." 6579 (interactive "^p") 6580 (let ((origin (point)) 6581 (special (pcase markdown-special-ctrl-a/e 6582 (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) 6583 deactivate-mark) 6584 ;; First move to a visible line. 6585 (if visual-line-mode 6586 (beginning-of-visual-line n) 6587 (move-beginning-of-line n) 6588 ;; `move-beginning-of-line' may leave point after invisible 6589 ;; characters if line starts with such of these (e.g., with 6590 ;; a link at column 0). Really move to the beginning of the 6591 ;; current visible line. 6592 (forward-line 0)) 6593 (cond 6594 ;; No special behavior. Point is already at the beginning of 6595 ;; a line, logical or visual. 6596 ((not special)) 6597 ;; `beginning-of-visual-line' left point before logical beginning 6598 ;; of line: point is at the beginning of a visual line. Bail 6599 ;; out. 6600 ((and visual-line-mode (not (bolp)))) 6601 ((looking-at markdown-regex-header-atx) 6602 ;; At a header, special position is before the title. 6603 (let ((refpos (match-beginning 2)) 6604 (bol (point))) 6605 (if (eq special 'reversed) 6606 (when (and (= origin bol) (eq last-command this-command)) 6607 (goto-char refpos)) 6608 (when (or (> origin refpos) (<= origin bol)) 6609 (goto-char refpos))) 6610 ;; Prevent automatic cursor movement caused by the command loop. 6611 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6612 (when (and markdown-hide-markup 6613 (equal (get-char-property (point) 'display) "")) 6614 (setq disable-point-adjustment t)))) 6615 ((looking-at markdown-regex-list) 6616 ;; At a list item, special position is after the list marker or checkbox. 6617 (let ((refpos (or (match-end 4) (match-end 3)))) 6618 (if (eq special 'reversed) 6619 (when (and (= (point) origin) (eq last-command this-command)) 6620 (goto-char refpos)) 6621 (when (or (> origin refpos) (<= origin (line-beginning-position))) 6622 (goto-char refpos))))) 6623 ;; No special case, already at beginning of line. 6624 (t nil)))) 6625 6626 ;; This function was originally derived from `org-end-of-line' from org.el. 6627 (defun markdown-end-of-line (&optional n) 6628 "Go to the end of the line, but before ellipsis, if any. 6629 6630 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6631 or symbol `reversed', ignore closing tags on the first attempt, 6632 and only move to after the closing tags when the cursor is 6633 already beyond the end of the headline. 6634 6635 If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore 6636 closing tags on the second attempt. 6637 6638 With argument N not nil or 1, move forward N - 1 lines first." 6639 (interactive "^p") 6640 (let ((origin (point)) 6641 (special (pcase markdown-special-ctrl-a/e 6642 (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) 6643 deactivate-mark) 6644 ;; First move to a visible line. 6645 (if visual-line-mode 6646 (beginning-of-visual-line n) 6647 (move-beginning-of-line n)) 6648 (cond 6649 ;; At a headline, with closing tags. 6650 ((save-excursion 6651 (forward-line 0) 6652 (and (looking-at markdown-regex-header-atx) (match-end 3))) 6653 (let ((refpos (match-end 2)) 6654 (visual-end (and visual-line-mode 6655 (save-excursion 6656 (end-of-visual-line) 6657 (point))))) 6658 ;; If `end-of-visual-line' brings us before end of line or even closing 6659 ;; tags, i.e., the headline spans over multiple visual lines, move 6660 ;; there. 6661 (cond ((and visual-end 6662 (< visual-end refpos) 6663 (<= origin visual-end)) 6664 (goto-char visual-end)) 6665 ((not special) (end-of-line)) 6666 ((eq special 'reversed) 6667 (if (and (= origin (line-end-position)) 6668 (eq this-command last-command)) 6669 (goto-char refpos) 6670 (end-of-line))) 6671 (t 6672 (if (or (< origin refpos) (>= origin (line-end-position))) 6673 (goto-char refpos) 6674 (end-of-line)))) 6675 ;; Prevent automatic cursor movement caused by the command loop. 6676 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6677 (when (and markdown-hide-markup 6678 (equal (get-char-property (point) 'display) "")) 6679 (setq disable-point-adjustment t)))) 6680 (visual-line-mode 6681 (let ((bol (line-beginning-position))) 6682 (end-of-visual-line) 6683 ;; If `end-of-visual-line' gets us past the ellipsis at the 6684 ;; end of a line, backtrack and use `end-of-line' instead. 6685 (when (/= bol (line-beginning-position)) 6686 (goto-char bol) 6687 (end-of-line)))) 6688 (t (end-of-line))))) 6689 6690 (defun markdown-beginning-of-defun (&optional arg) 6691 "`beginning-of-defun-function' for Markdown. 6692 This is used to find the beginning of the defun and should behave 6693 like ‘beginning-of-defun’, returning non-nil if it found the 6694 beginning of a defun. It moves the point backward, right before a 6695 heading which defines a defun. When ARG is non-nil, repeat that 6696 many times. When ARG is negative, move forward to the ARG-th 6697 following section." 6698 (or arg (setq arg 1)) 6699 (when (< arg 0) (end-of-line)) 6700 ;; Adjust position for setext headings. 6701 (when (and (thing-at-point-looking-at markdown-regex-header-setext) 6702 (not (= (point) (match-beginning 0))) 6703 (not (markdown-code-block-at-point-p))) 6704 (goto-char (match-end 0))) 6705 (let (found) 6706 ;; Move backward with positive argument. 6707 (while (and (not (bobp)) (> arg 0)) 6708 (setq found nil) 6709 (while (and (not found) 6710 (not (bobp)) 6711 (re-search-backward markdown-regex-header nil 'move)) 6712 (markdown-code-block-at-pos (match-beginning 0)) 6713 (setq found (match-beginning 0))) 6714 (setq arg (1- arg))) 6715 ;; Move forward with negative argument. 6716 (while (and (not (eobp)) (< arg 0)) 6717 (setq found nil) 6718 (while (and (not found) 6719 (not (eobp)) 6720 (re-search-forward markdown-regex-header nil 'move)) 6721 (markdown-code-block-at-pos (match-beginning 0)) 6722 (setq found (match-beginning 0))) 6723 (setq arg (1+ arg))) 6724 (when found 6725 (beginning-of-line) 6726 t))) 6727 6728 (defun markdown-end-of-defun () 6729 "`end-of-defun-function’ for Markdown. 6730 This is used to find the end of the defun at point. 6731 It is called with no argument, right after calling ‘beginning-of-defun-raw’, 6732 so it can assume that point is at the beginning of the defun body. 6733 It should move point to the first position after the defun." 6734 (or (eobp) (forward-char 1)) 6735 (let (found) 6736 (while (and (not found) 6737 (not (eobp)) 6738 (re-search-forward markdown-regex-header nil 'move)) 6739 (when (not (markdown-code-block-at-pos (match-beginning 0))) 6740 (setq found (match-beginning 0)))) 6741 (when found 6742 (goto-char found) 6743 (skip-syntax-backward "-")))) 6744 6745 (defun markdown-beginning-of-text-block () 6746 "Move backward to previous beginning of a plain text block. 6747 This function simply looks for blank lines without considering 6748 the surrounding context in light of Markdown syntax. For that, see 6749 `markdown-backward-block'." 6750 (interactive) 6751 (let ((start (point))) 6752 (if (re-search-backward markdown-regex-block-separator nil t) 6753 (goto-char (match-end 0)) 6754 (goto-char (point-min))) 6755 (when (and (= start (point)) (not (bobp))) 6756 (forward-line -1) 6757 (if (re-search-backward markdown-regex-block-separator nil t) 6758 (goto-char (match-end 0)) 6759 (goto-char (point-min)))))) 6760 6761 (defun markdown-end-of-text-block () 6762 "Move forward to next beginning of a plain text block. 6763 This function simply looks for blank lines without considering 6764 the surrounding context in light of Markdown syntax. For that, see 6765 `markdown-forward-block'." 6766 (interactive) 6767 (beginning-of-line) 6768 (skip-chars-forward " \t\n") 6769 (when (= (point) (point-min)) 6770 (forward-char)) 6771 (if (re-search-forward markdown-regex-block-separator nil t) 6772 (goto-char (match-end 0)) 6773 (goto-char (point-max))) 6774 (skip-chars-backward " \t\n") 6775 (forward-line)) 6776 6777 (defun markdown-backward-paragraph (&optional arg) 6778 "Move the point to the start of the current paragraph. 6779 With argument ARG, do it ARG times; a negative argument ARG = -N 6780 means move forward N blocks." 6781 (interactive "^p") 6782 (or arg (setq arg 1)) 6783 (if (< arg 0) 6784 (markdown-forward-paragraph (- arg)) 6785 (dotimes (_ arg) 6786 ;; Skip over whitespace in between paragraphs when moving backward. 6787 (skip-chars-backward " \t\n") 6788 (beginning-of-line) 6789 ;; Skip over code block endings. 6790 (when (markdown-range-properties-exist 6791 (line-beginning-position) (line-end-position) 6792 '(markdown-gfm-block-end 6793 markdown-tilde-fence-end)) 6794 (forward-line -1)) 6795 ;; Skip over blank lines inside blockquotes. 6796 (while (and (not (eobp)) 6797 (looking-at markdown-regex-blockquote) 6798 (= (length (match-string 3)) 0)) 6799 (forward-line -1)) 6800 ;; Proceed forward based on the type of block of paragraph. 6801 (let (bounds skip) 6802 (cond 6803 ;; Blockquotes 6804 ((looking-at markdown-regex-blockquote) 6805 (while (and (not (bobp)) 6806 (looking-at markdown-regex-blockquote) 6807 (> (length (match-string 3)) 0)) ;; not blank 6808 (forward-line -1)) 6809 (forward-line)) 6810 ;; List items 6811 ((setq bounds (markdown-cur-list-item-bounds)) 6812 (goto-char (nth 0 bounds))) 6813 ;; Other 6814 (t 6815 (while (and (not (bobp)) 6816 (not skip) 6817 (not (markdown-cur-line-blank-p)) 6818 (not (looking-at markdown-regex-blockquote)) 6819 (not (markdown-range-properties-exist 6820 (line-beginning-position) (line-end-position) 6821 '(markdown-gfm-block-end 6822 markdown-tilde-fence-end)))) 6823 (setq skip (markdown-range-properties-exist 6824 (line-beginning-position) (line-end-position) 6825 '(markdown-gfm-block-begin 6826 markdown-tilde-fence-begin))) 6827 (forward-line -1)) 6828 (unless (bobp) 6829 (forward-line 1)))))))) 6830 6831 (defun markdown-forward-paragraph (&optional arg) 6832 "Move forward to the next end of a paragraph. 6833 With argument ARG, do it ARG times; a negative argument ARG = -N 6834 means move backward N blocks." 6835 (interactive "^p") 6836 (or arg (setq arg 1)) 6837 (if (< arg 0) 6838 (markdown-backward-paragraph (- arg)) 6839 (dotimes (_ arg) 6840 ;; Skip whitespace in between paragraphs. 6841 (when (markdown-cur-line-blank-p) 6842 (skip-syntax-forward "-") 6843 (beginning-of-line)) 6844 ;; Proceed forward based on the type of block. 6845 (let (bounds skip) 6846 (cond 6847 ;; Blockquotes 6848 ((looking-at markdown-regex-blockquote) 6849 ;; Skip over blank lines inside blockquotes. 6850 (while (and (not (eobp)) 6851 (looking-at markdown-regex-blockquote) 6852 (= (length (match-string 3)) 0)) 6853 (forward-line)) 6854 ;; Move to end of quoted text block 6855 (while (and (not (eobp)) 6856 (looking-at markdown-regex-blockquote) 6857 (> (length (match-string 3)) 0)) ;; not blank 6858 (forward-line))) 6859 ;; List items 6860 ((and (markdown-cur-list-item-bounds) 6861 (setq bounds (markdown-next-list-item-bounds))) 6862 (goto-char (nth 0 bounds))) 6863 ;; Other 6864 (t 6865 (forward-line) 6866 (while (and (not (eobp)) 6867 (not skip) 6868 (not (markdown-cur-line-blank-p)) 6869 (not (looking-at markdown-regex-blockquote)) 6870 (not (markdown-range-properties-exist 6871 (line-beginning-position) (line-end-position) 6872 '(markdown-gfm-block-begin 6873 markdown-tilde-fence-begin)))) 6874 (setq skip (markdown-range-properties-exist 6875 (line-beginning-position) (line-end-position) 6876 '(markdown-gfm-block-end 6877 markdown-tilde-fence-end))) 6878 (forward-line)))))))) 6879 6880 (defun markdown-backward-block (&optional arg) 6881 "Move the point to the start of the current Markdown block. 6882 Moves across complete code blocks, list items, and blockquotes, 6883 but otherwise stops at blank lines, headers, and horizontal 6884 rules. With argument ARG, do it ARG times; a negative argument 6885 ARG = -N means move forward N blocks." 6886 (interactive "^p") 6887 (or arg (setq arg 1)) 6888 (if (< arg 0) 6889 (markdown-forward-block (- arg)) 6890 (dotimes (_ arg) 6891 ;; Skip over whitespace in between blocks when moving backward, 6892 ;; unless at a block boundary with no whitespace. 6893 (skip-syntax-backward "-") 6894 (beginning-of-line) 6895 ;; Proceed forward based on the type of block. 6896 (cond 6897 ;; Code blocks 6898 ((and (markdown-code-block-at-pos (point)) ;; this line 6899 (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line 6900 (forward-line -1) 6901 (while (and (markdown-code-block-at-point-p) (not (bobp))) 6902 (forward-line -1)) 6903 (forward-line)) 6904 ;; Headings 6905 ((markdown-heading-at-point) 6906 (goto-char (match-beginning 0))) 6907 ;; Horizontal rules 6908 ((looking-at markdown-regex-hr)) 6909 ;; Blockquotes 6910 ((looking-at markdown-regex-blockquote) 6911 (forward-line -1) 6912 (while (and (looking-at markdown-regex-blockquote) 6913 (not (bobp))) 6914 (forward-line -1)) 6915 (forward-line)) 6916 ;; List items 6917 ((markdown-cur-list-item-bounds) 6918 (markdown-beginning-of-list)) 6919 ;; Other 6920 (t 6921 ;; Move forward in case it is a one line regular paragraph. 6922 (unless (markdown-next-line-blank-p) 6923 (forward-line)) 6924 (unless (markdown-prev-line-blank-p) 6925 (markdown-backward-paragraph))))))) 6926 6927 (defun markdown-forward-block (&optional arg) 6928 "Move forward to the next end of a Markdown block. 6929 Moves across complete code blocks, list items, and blockquotes, 6930 but otherwise stops at blank lines, headers, and horizontal 6931 rules. With argument ARG, do it ARG times; a negative argument 6932 ARG = -N means move backward N blocks." 6933 (interactive "^p") 6934 (or arg (setq arg 1)) 6935 (if (< arg 0) 6936 (markdown-backward-block (- arg)) 6937 (dotimes (_ arg) 6938 ;; Skip over whitespace in between blocks when moving forward. 6939 (if (markdown-cur-line-blank-p) 6940 (skip-syntax-forward "-") 6941 (beginning-of-line)) 6942 ;; Proceed forward based on the type of block. 6943 (cond 6944 ;; Code blocks 6945 ((markdown-code-block-at-point-p) 6946 (forward-line) 6947 (while (and (markdown-code-block-at-point-p) (not (eobp))) 6948 (forward-line))) 6949 ;; Headings 6950 ((looking-at markdown-regex-header) 6951 (goto-char (or (match-end 4) (match-end 2) (match-end 3))) 6952 (forward-line)) 6953 ;; Horizontal rules 6954 ((looking-at markdown-regex-hr) 6955 (forward-line)) 6956 ;; Blockquotes 6957 ((looking-at markdown-regex-blockquote) 6958 (forward-line) 6959 (while (and (looking-at markdown-regex-blockquote) (not (eobp))) 6960 (forward-line))) 6961 ;; List items 6962 ((markdown-cur-list-item-bounds) 6963 (markdown-end-of-list) 6964 (forward-line)) 6965 ;; Other 6966 (t (markdown-forward-paragraph)))) 6967 (skip-syntax-backward "-") 6968 (unless (eobp) 6969 (forward-char 1)))) 6970 6971 (defun markdown-backward-page (&optional count) 6972 "Move backward to boundary of the current toplevel section. 6973 With COUNT, repeat, or go forward if negative." 6974 (interactive "p") 6975 (or count (setq count 1)) 6976 (if (< count 0) 6977 (markdown-forward-page (- count)) 6978 (skip-syntax-backward "-") 6979 (or (markdown-back-to-heading-over-code-block t t) 6980 (goto-char (point-min))) 6981 (when (looking-at markdown-regex-header) 6982 (let ((level (markdown-outline-level))) 6983 (when (> level 1) (markdown-up-heading level)) 6984 (when (> count 1) 6985 (condition-case nil 6986 (markdown-backward-same-level (1- count)) 6987 (error (goto-char (point-min))))))))) 6988 6989 (defun markdown-forward-page (&optional count) 6990 "Move forward to boundary of the current toplevel section. 6991 With COUNT, repeat, or go backward if negative." 6992 (interactive "p") 6993 (or count (setq count 1)) 6994 (if (< count 0) 6995 (markdown-backward-page (- count)) 6996 (if (markdown-back-to-heading-over-code-block t t) 6997 (let ((level (markdown-outline-level))) 6998 (when (> level 1) (markdown-up-heading level)) 6999 (condition-case nil 7000 (markdown-forward-same-level count) 7001 (error (goto-char (point-max))))) 7002 (markdown-next-visible-heading 1)))) 7003 7004 (defun markdown-next-link () 7005 "Jump to next inline, reference, or wiki link. 7006 If successful, return point. Otherwise, return nil. 7007 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." 7008 (interactive) 7009 (let ((opoint (point))) 7010 (when (or (markdown-link-p) (markdown-wiki-link-p)) 7011 ;; At a link already, move past it. 7012 (goto-char (+ (match-end 0) 1))) 7013 ;; Search for the next wiki link and move to the beginning. 7014 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) 7015 (markdown-code-block-at-point-p) 7016 (< (point) (point-max)))) 7017 (if (and (not (eq (point) opoint)) 7018 (or (markdown-link-p) (markdown-wiki-link-p))) 7019 ;; Group 1 will move past non-escape character in wiki link regexp. 7020 ;; Go to beginning of group zero for all other link types. 7021 (goto-char (or (match-beginning 1) (match-beginning 0))) 7022 (goto-char opoint) 7023 nil))) 7024 7025 (defun markdown-previous-link () 7026 "Jump to previous wiki link. 7027 If successful, return point. Otherwise, return nil. 7028 See `markdown-wiki-link-p' and `markdown-next-wiki-link'." 7029 (interactive) 7030 (let ((opoint (point))) 7031 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) 7032 (markdown-code-block-at-point-p) 7033 (> (point) (point-min)))) 7034 (if (and (not (eq (point) opoint)) 7035 (or (markdown-link-p) (markdown-wiki-link-p))) 7036 (goto-char (or (match-beginning 1) (match-beginning 0))) 7037 (goto-char opoint) 7038 nil))) 7039 7040 7041 ;;; Outline =================================================================== 7042 7043 (defun markdown-move-heading-common (move-fn &optional arg adjust) 7044 "Wrapper for `outline-mode' functions to skip false positives. 7045 MOVE-FN is a function and ARG is its argument. For example, 7046 headings inside preformatted code blocks may match 7047 `outline-regexp' but should not be considered as headings. 7048 When ADJUST is non-nil, adjust the point for interactive calls 7049 to avoid leaving the point at invisible markup. This adjustment 7050 generally should only be done for interactive calls, since other 7051 functions may expect the point to be at the beginning of the 7052 regular expression." 7053 (let ((prev -1) (start (point))) 7054 (if arg (funcall move-fn arg) (funcall move-fn)) 7055 (while (and (/= prev (point)) (markdown-code-block-at-point-p)) 7056 (setq prev (point)) 7057 (if arg (funcall move-fn arg) (funcall move-fn))) 7058 ;; Adjust point for setext headings and invisible text. 7059 (save-match-data 7060 (when (and adjust (thing-at-point-looking-at markdown-regex-header)) 7061 (if markdown-hide-markup 7062 ;; Move to beginning of heading text if markup is hidden. 7063 (goto-char (or (match-beginning 1) (match-beginning 5))) 7064 ;; Move to beginning of markup otherwise. 7065 (goto-char (or (match-beginning 1) (match-beginning 4)))))) 7066 (if (= (point) start) nil (point)))) 7067 7068 (defun markdown-next-visible-heading (arg) 7069 "Move to the next visible heading line of any level. 7070 With argument, repeats or can move backward if negative. ARG is 7071 passed to `outline-next-visible-heading'." 7072 (interactive "p") 7073 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) 7074 7075 (defun markdown-previous-visible-heading (arg) 7076 "Move to the previous visible heading line of any level. 7077 With argument, repeats or can move backward if negative. ARG is 7078 passed to `outline-previous-visible-heading'." 7079 (interactive "p") 7080 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) 7081 7082 (defun markdown-next-heading () 7083 "Move to the next heading line of any level." 7084 (markdown-move-heading-common #'outline-next-heading)) 7085 7086 (defun markdown-previous-heading () 7087 "Move to the previous heading line of any level." 7088 (markdown-move-heading-common #'outline-previous-heading)) 7089 7090 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) 7091 "Move back to the beginning of the previous heading. 7092 Returns t if the point is at a heading, the location if a heading 7093 was found, and nil otherwise. 7094 Only visible heading lines are considered, unless INVISIBLE-OK is 7095 non-nil. Throw an error if there is no previous heading unless 7096 NO-ERROR is non-nil. 7097 Leaves match data intact for `markdown-regex-header'." 7098 (beginning-of-line) 7099 (or (and (markdown-heading-at-point) 7100 (not (markdown-code-block-at-point-p))) 7101 (let (found) 7102 (save-excursion 7103 (while (and (not found) 7104 (re-search-backward markdown-regex-header nil t)) 7105 (when (and (or invisible-ok (not (outline-invisible-p))) 7106 (not (markdown-code-block-at-point-p))) 7107 (setq found (point)))) 7108 (if (not found) 7109 (unless no-error (user-error "Before first heading")) 7110 (setq found (point)))) 7111 (when found (goto-char found))))) 7112 7113 (defun markdown-forward-same-level (arg) 7114 "Move forward to the ARG'th heading at same level as this one. 7115 Stop at the first and last headings of a superior heading." 7116 (interactive "p") 7117 (markdown-back-to-heading-over-code-block) 7118 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) 7119 7120 (defun markdown-backward-same-level (arg) 7121 "Move backward to the ARG'th heading at same level as this one. 7122 Stop at the first and last headings of a superior heading." 7123 (interactive "p") 7124 (markdown-back-to-heading-over-code-block) 7125 (while (> arg 0) 7126 (let ((point-to-move-to 7127 (save-excursion 7128 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) 7129 (if point-to-move-to 7130 (progn 7131 (goto-char point-to-move-to) 7132 (setq arg (1- arg))) 7133 (user-error "No previous same-level heading"))))) 7134 7135 (defun markdown-up-heading (arg &optional interactive) 7136 "Move to the visible heading line of which the present line is a subheading. 7137 With argument, move up ARG levels. When called interactively (or 7138 INTERACTIVE is non-nil), also push the mark." 7139 (interactive "p\np") 7140 (and interactive (not (eq last-command 'markdown-up-heading)) 7141 (push-mark)) 7142 (markdown-move-heading-common #'outline-up-heading arg 'adjust)) 7143 7144 (defun markdown-back-to-heading (&optional invisible-ok) 7145 "Move to previous heading line, or beg of this line if it's a heading. 7146 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 7147 (interactive) 7148 (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) 7149 7150 (defalias 'markdown-end-of-heading 'outline-end-of-heading) 7151 7152 (defun markdown-on-heading-p () 7153 "Return non-nil if point is on a heading line." 7154 (get-text-property (line-beginning-position) 'markdown-heading)) 7155 7156 (defun markdown-end-of-subtree (&optional invisible-OK) 7157 "Move to the end of the current subtree. 7158 Only visible heading lines are considered, unless INVISIBLE-OK is 7159 non-nil. 7160 Derived from `org-end-of-subtree'." 7161 (markdown-back-to-heading invisible-OK) 7162 (let ((first t) 7163 (level (markdown-outline-level))) 7164 (while (and (not (eobp)) 7165 (or first (> (markdown-outline-level) level))) 7166 (setq first nil) 7167 (markdown-next-heading)) 7168 (if (memq (preceding-char) '(?\n ?\^M)) 7169 (progn 7170 ;; Go to end of line before heading 7171 (forward-char -1) 7172 (if (memq (preceding-char) '(?\n ?\^M)) 7173 ;; leave blank line before heading 7174 (forward-char -1))))) 7175 (point)) 7176 7177 (defun markdown-outline-fix-visibility () 7178 "Hide any false positive headings that should not be shown. 7179 For example, headings inside preformatted code blocks may match 7180 `outline-regexp' but should not be shown as headings when cycling. 7181 Also, the ending --- line in metadata blocks appears to be a 7182 setext header, but should not be folded." 7183 (save-excursion 7184 (goto-char (point-min)) 7185 ;; Unhide any false positives in metadata blocks 7186 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) 7187 (let ((body (progn (forward-line) 7188 (markdown-text-property-at-point 7189 'markdown-yaml-metadata-section)))) 7190 (when body 7191 (let ((end (progn (goto-char (cl-second body)) 7192 (markdown-text-property-at-point 7193 'markdown-yaml-metadata-end)))) 7194 (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) 7195 ;; Hide any false positives in code blocks 7196 (unless (outline-on-heading-p) 7197 (outline-next-visible-heading 1)) 7198 (while (< (point) (point-max)) 7199 (when (markdown-code-block-at-point-p) 7200 (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) 7201 (outline-next-visible-heading 1)))) 7202 7203 (defvar markdown-cycle-global-status 1) 7204 (defvar markdown-cycle-subtree-status nil) 7205 7206 (defun markdown-next-preface () 7207 (let (finish) 7208 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") 7209 nil 'move)) 7210 (unless (markdown-code-block-at-point-p) 7211 (goto-char (match-beginning 0)) 7212 (setq finish t)))) 7213 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) 7214 (forward-char -1))) 7215 7216 (defun markdown-show-entry () 7217 (save-excursion 7218 (outline-back-to-heading t) 7219 (outline-flag-region (1- (point)) 7220 (progn 7221 (markdown-next-preface) 7222 (if (= 1 (- (point-max) (point))) 7223 (point-max) 7224 (point))) 7225 nil))) 7226 7227 ;; This function was originally derived from `org-cycle' from org.el. 7228 (defun markdown-cycle (&optional arg) 7229 "Visibility cycling for Markdown mode. 7230 This function is called with a `\\[universal-argument]' or if ARG is t, perform 7231 global visibility cycling. If the point is at an atx-style header, cycle 7232 visibility of the corresponding subtree. Otherwise, indent the current line 7233 or insert a tab, as appropriate, by calling `indent-for-tab-command'." 7234 (interactive "P") 7235 (cond 7236 7237 ;; Global cycling 7238 (arg 7239 (cond 7240 ;; Move from overview to contents 7241 ((and (eq last-command this-command) 7242 (eq markdown-cycle-global-status 2)) 7243 (outline-hide-sublevels 1) 7244 (message "CONTENTS") 7245 (setq markdown-cycle-global-status 3) 7246 (markdown-outline-fix-visibility)) 7247 ;; Move from contents to all 7248 ((and (eq last-command this-command) 7249 (eq markdown-cycle-global-status 3)) 7250 (outline-show-all) 7251 (message "SHOW ALL") 7252 (setq markdown-cycle-global-status 1)) 7253 ;; Defaults to overview 7254 (t 7255 (outline-hide-body) 7256 (message "OVERVIEW") 7257 (setq markdown-cycle-global-status 2) 7258 (markdown-outline-fix-visibility)))) 7259 7260 ;; At a heading: rotate between three different views 7261 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) 7262 (markdown-back-to-heading) 7263 (let ((goal-column 0) eoh eol eos) 7264 ;; Determine boundaries 7265 (save-excursion 7266 (markdown-back-to-heading) 7267 (save-excursion 7268 (beginning-of-line 2) 7269 (while (and (not (eobp)) ;; this is like `next-line' 7270 (get-char-property (1- (point)) 'invisible)) 7271 (beginning-of-line 2)) (setq eol (point))) 7272 (markdown-end-of-heading) (setq eoh (point)) 7273 (markdown-end-of-subtree t) 7274 (skip-chars-forward " \t\n") 7275 (beginning-of-line 1) ; in case this is an item 7276 (setq eos (1- (point)))) 7277 ;; Find out what to do next and set `this-command' 7278 (cond 7279 ;; Nothing is hidden behind this heading 7280 ((= eos eoh) 7281 (message "EMPTY ENTRY") 7282 (setq markdown-cycle-subtree-status nil)) 7283 ;; Entire subtree is hidden in one line: open it 7284 ((>= eol eos) 7285 (markdown-show-entry) 7286 (outline-show-children) 7287 (message "CHILDREN") 7288 (setq markdown-cycle-subtree-status 'children)) 7289 ;; We just showed the children, now show everything. 7290 ((and (eq last-command this-command) 7291 (eq markdown-cycle-subtree-status 'children)) 7292 (outline-show-subtree) 7293 (message "SUBTREE") 7294 (setq markdown-cycle-subtree-status 'subtree)) 7295 ;; Default action: hide the subtree. 7296 (t 7297 (outline-hide-subtree) 7298 (message "FOLDED") 7299 (setq markdown-cycle-subtree-status 'folded))))) 7300 7301 ;; In a table, move forward by one cell 7302 ((markdown-table-at-point-p) 7303 (call-interactively #'markdown-table-forward-cell)) 7304 7305 ;; Otherwise, indent as appropriate 7306 (t 7307 (indent-for-tab-command)))) 7308 7309 (defun markdown-shifttab () 7310 "Handle S-TAB keybinding based on context. 7311 When in a table, move backward one cell. 7312 Otherwise, cycle global heading visibility by calling 7313 `markdown-cycle' with argument t." 7314 (interactive) 7315 (cond ((markdown-table-at-point-p) 7316 (call-interactively #'markdown-table-backward-cell)) 7317 (t (markdown-cycle t)))) 7318 7319 (defun markdown-outline-level () 7320 "Return the depth to which a statement is nested in the outline." 7321 (cond 7322 ((and (match-beginning 0) 7323 (markdown-code-block-at-pos (match-beginning 0))) 7324 7) ;; Only 6 header levels are defined. 7325 ((match-end 2) 1) 7326 ((match-end 3) 2) 7327 ((match-end 4) 7328 (length (markdown-trim-whitespace (match-string-no-properties 4)))))) 7329 7330 (defun markdown-promote-subtree (&optional arg) 7331 "Promote the current subtree of ATX headings. 7332 Note that Markdown does not support heading levels higher than 7333 six and therefore level-six headings will not be promoted 7334 further. If ARG is non-nil promote the heading, otherwise 7335 demote." 7336 (interactive "*P") 7337 (save-excursion 7338 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) 7339 (re-search-backward markdown-regex-header-atx nil t)) 7340 (not (markdown-code-block-at-point-p))) 7341 (let ((level (length (match-string 1))) 7342 (promote-or-demote (if arg 1 -1)) 7343 (remove 't)) 7344 (markdown-cycle-atx promote-or-demote remove) 7345 (catch 'end-of-subtree 7346 (while (and (markdown-next-heading) 7347 (looking-at markdown-regex-header-atx)) 7348 ;; Exit if this not a higher level heading; promote otherwise. 7349 (if (and (looking-at markdown-regex-header-atx) 7350 (<= (length (match-string-no-properties 1)) level)) 7351 (throw 'end-of-subtree nil) 7352 (markdown-cycle-atx promote-or-demote remove)))))))) 7353 7354 (defun markdown-demote-subtree () 7355 "Demote the current subtree of ATX headings." 7356 (interactive) 7357 (markdown-promote-subtree t)) 7358 7359 (defun markdown-move-subtree-up () 7360 "Move the current subtree of ATX headings up." 7361 (interactive) 7362 (outline-move-subtree-up 1)) 7363 7364 (defun markdown-move-subtree-down () 7365 "Move the current subtree of ATX headings down." 7366 (interactive) 7367 (outline-move-subtree-down 1)) 7368 7369 (defun markdown-outline-next () 7370 "Move to next list item, when in a list, or next visible heading." 7371 (interactive) 7372 (let ((bounds (markdown-next-list-item-bounds))) 7373 (if bounds 7374 (goto-char (nth 0 bounds)) 7375 (markdown-next-visible-heading 1)))) 7376 7377 (defun markdown-outline-previous () 7378 "Move to previous list item, when in a list, or previous visible heading." 7379 (interactive) 7380 (let ((bounds (markdown-prev-list-item-bounds))) 7381 (if bounds 7382 (goto-char (nth 0 bounds)) 7383 (markdown-previous-visible-heading 1)))) 7384 7385 (defun markdown-outline-next-same-level () 7386 "Move to next list item or heading of same level." 7387 (interactive) 7388 (let ((bounds (markdown-cur-list-item-bounds))) 7389 (if bounds 7390 (markdown-next-list-item (nth 3 bounds)) 7391 (markdown-forward-same-level 1)))) 7392 7393 (defun markdown-outline-previous-same-level () 7394 "Move to previous list item or heading of same level." 7395 (interactive) 7396 (let ((bounds (markdown-cur-list-item-bounds))) 7397 (if bounds 7398 (markdown-prev-list-item (nth 3 bounds)) 7399 (markdown-backward-same-level 1)))) 7400 7401 (defun markdown-outline-up () 7402 "Move to previous list item, when in a list, or previous heading." 7403 (interactive) 7404 (unless (markdown-up-list) 7405 (markdown-up-heading 1))) 7406 7407 7408 ;;; Marking and Narrowing ===================================================== 7409 7410 (defun markdown-mark-paragraph () 7411 "Put mark at end of this block, point at beginning. 7412 The block marked is the one that contains point or follows point. 7413 7414 Interactively, if this command is repeated or (in Transient Mark 7415 mode) if the mark is active, it marks the next block after the 7416 ones already marked." 7417 (interactive) 7418 (if (or (and (eq last-command this-command) (mark t)) 7419 (and transient-mark-mode mark-active)) 7420 (set-mark 7421 (save-excursion 7422 (goto-char (mark)) 7423 (markdown-forward-paragraph) 7424 (point))) 7425 (let ((beginning-of-defun-function #'markdown-backward-paragraph) 7426 (end-of-defun-function #'markdown-forward-paragraph)) 7427 (mark-defun)))) 7428 7429 (defun markdown-mark-block () 7430 "Put mark at end of this block, point at beginning. 7431 The block marked is the one that contains point or follows point. 7432 7433 Interactively, if this command is repeated or (in Transient Mark 7434 mode) if the mark is active, it marks the next block after the 7435 ones already marked." 7436 (interactive) 7437 (if (or (and (eq last-command this-command) (mark t)) 7438 (and transient-mark-mode mark-active)) 7439 (set-mark 7440 (save-excursion 7441 (goto-char (mark)) 7442 (markdown-forward-block) 7443 (point))) 7444 (let ((beginning-of-defun-function #'markdown-backward-block) 7445 (end-of-defun-function #'markdown-forward-block)) 7446 (mark-defun)))) 7447 7448 (defun markdown-narrow-to-block () 7449 "Make text outside current block invisible. 7450 The current block is the one that contains point or follows point." 7451 (interactive) 7452 (let ((beginning-of-defun-function #'markdown-backward-block) 7453 (end-of-defun-function #'markdown-forward-block)) 7454 (narrow-to-defun))) 7455 7456 (defun markdown-mark-text-block () 7457 "Put mark at end of this plain text block, point at beginning. 7458 The block marked is the one that contains point or follows point. 7459 7460 Interactively, if this command is repeated or (in Transient Mark 7461 mode) if the mark is active, it marks the next block after the 7462 ones already marked." 7463 (interactive) 7464 (if (or (and (eq last-command this-command) (mark t)) 7465 (and transient-mark-mode mark-active)) 7466 (set-mark 7467 (save-excursion 7468 (goto-char (mark)) 7469 (markdown-end-of-text-block) 7470 (point))) 7471 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) 7472 (end-of-defun-function #'markdown-end-of-text-block)) 7473 (mark-defun)))) 7474 7475 (defun markdown-mark-page () 7476 "Put mark at end of this top level section, point at beginning. 7477 The top level section marked is the one that contains point or 7478 follows point. 7479 7480 Interactively, if this command is repeated or (in Transient Mark 7481 mode) if the mark is active, it marks the next page after the 7482 ones already marked." 7483 (interactive) 7484 (if (or (and (eq last-command this-command) (mark t)) 7485 (and transient-mark-mode mark-active)) 7486 (set-mark 7487 (save-excursion 7488 (goto-char (mark)) 7489 (markdown-forward-page) 7490 (point))) 7491 (let ((beginning-of-defun-function #'markdown-backward-page) 7492 (end-of-defun-function #'markdown-forward-page)) 7493 (mark-defun)))) 7494 7495 (defun markdown-narrow-to-page () 7496 "Make text outside current top level section invisible. 7497 The current section is the one that contains point or follows point." 7498 (interactive) 7499 (let ((beginning-of-defun-function #'markdown-backward-page) 7500 (end-of-defun-function #'markdown-forward-page)) 7501 (narrow-to-defun))) 7502 7503 (defun markdown-mark-subtree () 7504 "Mark the current subtree. 7505 This puts point at the start of the current subtree, and mark at the end." 7506 (interactive) 7507 (let ((beg)) 7508 (if (markdown-heading-at-point) 7509 (beginning-of-line) 7510 (markdown-previous-visible-heading 1)) 7511 (setq beg (point)) 7512 (markdown-end-of-subtree) 7513 (push-mark (point) nil t) 7514 (goto-char beg))) 7515 7516 (defun markdown-narrow-to-subtree () 7517 "Narrow buffer to the current subtree." 7518 (interactive) 7519 (save-excursion 7520 (save-match-data 7521 (narrow-to-region 7522 (progn (markdown-back-to-heading-over-code-block t) (point)) 7523 (progn (markdown-end-of-subtree) 7524 (if (and (markdown-heading-at-point) (not (eobp))) 7525 (backward-char 1)) 7526 (point)))))) 7527 7528 7529 ;;; Generic Structure Editing, Completion, and Cycling Commands =============== 7530 7531 (defun markdown-move-up () 7532 "Move thing at point up. 7533 When in a list item, call `markdown-move-list-item-up'. 7534 When in a table, call `markdown-table-move-row-up'. 7535 Otherwise, move the current heading subtree up with 7536 `markdown-move-subtree-up'." 7537 (interactive) 7538 (cond 7539 ((markdown-list-item-at-point-p) 7540 (call-interactively #'markdown-move-list-item-up)) 7541 ((markdown-table-at-point-p) 7542 (call-interactively #'markdown-table-move-row-up)) 7543 (t 7544 (call-interactively #'markdown-move-subtree-up)))) 7545 7546 (defun markdown-move-down () 7547 "Move thing at point down. 7548 When in a list item, call `markdown-move-list-item-down'. 7549 Otherwise, move the current heading subtree up with 7550 `markdown-move-subtree-down'." 7551 (interactive) 7552 (cond 7553 ((markdown-list-item-at-point-p) 7554 (call-interactively #'markdown-move-list-item-down)) 7555 ((markdown-table-at-point-p) 7556 (call-interactively #'markdown-table-move-row-down)) 7557 (t 7558 (call-interactively #'markdown-move-subtree-down)))) 7559 7560 (defun markdown-promote () 7561 "Promote or move element at point to the left. 7562 Depending on the context, this function will promote a heading or 7563 list item at the point, move a table column to the left, or cycle 7564 markup." 7565 (interactive) 7566 (let (bounds) 7567 (cond 7568 ;; Promote atx heading subtree 7569 ((thing-at-point-looking-at markdown-regex-header-atx) 7570 (markdown-promote-subtree)) 7571 ;; Promote setext heading 7572 ((thing-at-point-looking-at markdown-regex-header-setext) 7573 (markdown-cycle-setext -1)) 7574 ;; Promote horizontal rule 7575 ((thing-at-point-looking-at markdown-regex-hr) 7576 (markdown-cycle-hr -1)) 7577 ;; Promote list item 7578 ((setq bounds (markdown-cur-list-item-bounds)) 7579 (markdown-promote-list-item bounds)) 7580 ;; Move table column to the left 7581 ((markdown-table-at-point-p) 7582 (call-interactively #'markdown-table-move-column-left)) 7583 ;; Promote bold 7584 ((thing-at-point-looking-at markdown-regex-bold) 7585 (markdown-cycle-bold)) 7586 ;; Promote italic 7587 ((thing-at-point-looking-at markdown-regex-italic) 7588 (markdown-cycle-italic)) 7589 (t 7590 (user-error "Nothing to promote at point"))))) 7591 7592 (defun markdown-demote () 7593 "Demote or move element at point to the right. 7594 Depending on the context, this function will demote a heading or 7595 list item at the point, move a table column to the right, or cycle 7596 or remove markup." 7597 (interactive) 7598 (let (bounds) 7599 (cond 7600 ;; Demote atx heading subtree 7601 ((thing-at-point-looking-at markdown-regex-header-atx) 7602 (markdown-demote-subtree)) 7603 ;; Demote setext heading 7604 ((thing-at-point-looking-at markdown-regex-header-setext) 7605 (markdown-cycle-setext 1)) 7606 ;; Demote horizontal rule 7607 ((thing-at-point-looking-at markdown-regex-hr) 7608 (markdown-cycle-hr 1)) 7609 ;; Demote list item 7610 ((setq bounds (markdown-cur-list-item-bounds)) 7611 (markdown-demote-list-item bounds)) 7612 ;; Move table column to the right 7613 ((markdown-table-at-point-p) 7614 (call-interactively #'markdown-table-move-column-right)) 7615 ;; Demote bold 7616 ((thing-at-point-looking-at markdown-regex-bold) 7617 (markdown-cycle-bold)) 7618 ;; Demote italic 7619 ((thing-at-point-looking-at markdown-regex-italic) 7620 (markdown-cycle-italic)) 7621 (t 7622 (user-error "Nothing to demote at point"))))) 7623 7624 7625 ;;; Commands ================================================================== 7626 7627 (defun markdown (&optional output-buffer-name) 7628 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. 7629 The output buffer name defaults to `markdown-output-buffer-name'. 7630 Return the name of the output buffer used." 7631 (interactive) 7632 (save-window-excursion 7633 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) 7634 ((listp markdown-command) markdown-command))) 7635 (command (car-safe commands)) 7636 (command-args (cdr-safe commands)) 7637 begin-region end-region) 7638 (if (use-region-p) 7639 (setq begin-region (region-beginning) 7640 end-region (region-end)) 7641 (setq begin-region (point-min) 7642 end-region (point-max))) 7643 7644 (unless output-buffer-name 7645 (setq output-buffer-name markdown-output-buffer-name)) 7646 (when (and (stringp command) (not (executable-find command))) 7647 (user-error "Markdown command %s is not found" command)) 7648 (let ((exit-code 7649 (cond 7650 ;; Handle case when `markdown-command' does not read from stdin 7651 ((and (stringp command) markdown-command-needs-filename) 7652 (if (not buffer-file-name) 7653 (user-error "Must be visiting a file") 7654 ;; Don’t use ‘shell-command’ because it’s not guaranteed to 7655 ;; return the exit code of the process. 7656 (let ((command (if (listp markdown-command) 7657 (string-join markdown-command " ") 7658 markdown-command))) 7659 (shell-command-on-region 7660 ;; Pass an empty region so that stdin is empty. 7661 (point) (point) 7662 (concat command " " 7663 (shell-quote-argument buffer-file-name)) 7664 output-buffer-name)))) 7665 ;; Pass region to `markdown-command' via stdin 7666 (t 7667 (let ((buf (get-buffer-create output-buffer-name))) 7668 (with-current-buffer buf 7669 (setq buffer-read-only nil) 7670 (erase-buffer)) 7671 (if (stringp command) 7672 (if (not (null command-args)) 7673 (apply #'call-process-region begin-region end-region command nil buf nil command-args) 7674 (call-process-region begin-region end-region command nil buf)) 7675 (if markdown-command-needs-filename 7676 (if (not buffer-file-name) 7677 (user-error "Must be visiting a file") 7678 (funcall markdown-command begin-region end-region buf buffer-file-name)) 7679 (funcall markdown-command begin-region end-region buf)) 7680 ;; If the ‘markdown-command’ function didn’t signal an 7681 ;; error, assume it succeeded by binding ‘exit-code’ to 0. 7682 0)))))) 7683 ;; The exit code can be a signal description string, so don’t use ‘=’ 7684 ;; or ‘zerop’. 7685 (unless (eq exit-code 0) 7686 (user-error "%s failed with exit code %s" 7687 markdown-command exit-code)))) 7688 output-buffer-name)) 7689 7690 (defun markdown-standalone (&optional output-buffer-name) 7691 "Special function to provide standalone HTML output. 7692 Insert the output in the buffer named OUTPUT-BUFFER-NAME." 7693 (interactive) 7694 (setq output-buffer-name (markdown output-buffer-name)) 7695 (with-current-buffer output-buffer-name 7696 (set-buffer output-buffer-name) 7697 (unless (markdown-output-standalone-p) 7698 (markdown-add-xhtml-header-and-footer output-buffer-name)) 7699 (goto-char (point-min)) 7700 (html-mode)) 7701 output-buffer-name) 7702 7703 (defun markdown-other-window (&optional output-buffer-name) 7704 "Run `markdown-command' on current buffer and display in other window. 7705 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7706 that name." 7707 (interactive) 7708 (markdown-display-buffer-other-window 7709 (markdown-standalone output-buffer-name))) 7710 7711 (defun markdown-output-standalone-p () 7712 "Determine whether `markdown-command' output is standalone XHTML. 7713 Standalone XHTML output is identified by an occurrence of 7714 `markdown-xhtml-standalone-regexp' in the first five lines of output." 7715 (save-excursion 7716 (goto-char (point-min)) 7717 (save-match-data 7718 (re-search-forward 7719 markdown-xhtml-standalone-regexp 7720 (save-excursion (goto-char (point-min)) (forward-line 4) (point)) 7721 t)))) 7722 7723 (defun markdown-stylesheet-link-string (stylesheet-path) 7724 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" 7725 (or (and (string-prefix-p "~" stylesheet-path) 7726 (expand-file-name stylesheet-path)) 7727 stylesheet-path) 7728 "\" />")) 7729 7730 (defun markdown-escape-title (title) 7731 "Escape a minimum set of characters in TITLE so they don't clash with html." 7732 (replace-regexp-in-string ">" ">" 7733 (replace-regexp-in-string "<" "<" 7734 (replace-regexp-in-string "&" "&" title)))) 7735 7736 (defun markdown-add-xhtml-header-and-footer (title) 7737 "Wrap XHTML header and footer with given TITLE around current buffer." 7738 (goto-char (point-min)) 7739 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" 7740 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" 7741 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" 7742 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" 7743 "<head>\n<title>") 7744 (insert (markdown-escape-title title)) 7745 (insert "</title>\n") 7746 (unless (= (length markdown-content-type) 0) 7747 (insert 7748 (format 7749 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" 7750 markdown-content-type 7751 (or (and markdown-coding-system 7752 (coding-system-get markdown-coding-system 7753 'mime-charset)) 7754 (coding-system-get buffer-file-coding-system 7755 'mime-charset) 7756 "utf-8")))) 7757 (if (> (length markdown-css-paths) 0) 7758 (insert (mapconcat #'markdown-stylesheet-link-string 7759 markdown-css-paths "\n"))) 7760 (when (> (length markdown-xhtml-header-content) 0) 7761 (insert markdown-xhtml-header-content)) 7762 (insert "\n</head>\n\n" 7763 "<body>\n\n") 7764 (when (> (length markdown-xhtml-body-preamble) 0) 7765 (insert markdown-xhtml-body-preamble "\n")) 7766 (goto-char (point-max)) 7767 (when (> (length markdown-xhtml-body-epilogue) 0) 7768 (insert "\n" markdown-xhtml-body-epilogue)) 7769 (insert "\n" 7770 "</body>\n" 7771 "</html>\n")) 7772 7773 (defun markdown-preview (&optional output-buffer-name) 7774 "Run `markdown-command' on the current buffer and view output in browser. 7775 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7776 that name." 7777 (interactive) 7778 (browse-url-of-buffer 7779 (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) 7780 7781 (defun markdown-export-file-name (&optional extension) 7782 "Attempt to generate a filename for Markdown output. 7783 The file extension will be EXTENSION if given, or .html by default. 7784 If the current buffer is visiting a file, we construct a new 7785 output filename based on that filename. Otherwise, return nil." 7786 (when (buffer-file-name) 7787 (unless extension 7788 (setq extension ".html")) 7789 (let ((candidate 7790 (concat 7791 (cond 7792 ((buffer-file-name) 7793 (file-name-sans-extension (buffer-file-name))) 7794 (t (buffer-name))) 7795 extension))) 7796 (cond 7797 ((equal candidate (buffer-file-name)) 7798 (concat candidate extension)) 7799 (t 7800 candidate))))) 7801 7802 (defun markdown-export (&optional output-file) 7803 "Run Markdown on the current buffer, save to file, and return the filename. 7804 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename 7805 generated by `markdown-export-file-name', which will be constructed using the 7806 current filename, but with the extension removed and replaced with .html." 7807 (interactive) 7808 (unless output-file 7809 (setq output-file (markdown-export-file-name ".html"))) 7810 (when output-file 7811 (let* ((init-buf (current-buffer)) 7812 (init-point (point)) 7813 (init-buf-string (buffer-string)) 7814 (output-buffer (find-file-noselect output-file)) 7815 (output-buffer-name (buffer-name output-buffer))) 7816 (run-hooks 'markdown-before-export-hook) 7817 (markdown-standalone output-buffer-name) 7818 (with-current-buffer output-buffer 7819 (run-hooks 'markdown-after-export-hook) 7820 (save-buffer) 7821 (when markdown-export-kill-buffer (kill-buffer))) 7822 ;; if modified, restore initial buffer 7823 (when (buffer-modified-p init-buf) 7824 (erase-buffer) 7825 (insert init-buf-string) 7826 (save-buffer) 7827 (goto-char init-point)) 7828 output-file))) 7829 7830 (defun markdown-export-and-preview () 7831 "Export to XHTML using `markdown-export' and browse the resulting file." 7832 (interactive) 7833 (browse-url-of-file (markdown-export))) 7834 7835 (defvar-local markdown-live-preview-buffer nil 7836 "Buffer used to preview markdown output in `markdown-live-preview-export'.") 7837 7838 (defvar-local markdown-live-preview-source-buffer nil 7839 "Source buffer from which current buffer was generated. 7840 This is the inverse of `markdown-live-preview-buffer'.") 7841 7842 (defvar markdown-live-preview-currently-exporting nil) 7843 7844 (defun markdown-live-preview-get-filename () 7845 "Standardize the filename exported by `markdown-live-preview-export'." 7846 (markdown-export-file-name ".html")) 7847 7848 (defun markdown-live-preview-window-eww (file) 7849 "Preview FILE with eww. 7850 To be used with `markdown-live-preview-window-function'." 7851 (when (and (bound-and-true-p eww-auto-rename-buffer) 7852 markdown-live-preview-buffer) 7853 (kill-buffer markdown-live-preview-buffer)) 7854 (eww-open-file file) 7855 ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" 7856 ;; Try to find the buffer whose name ends with "eww*" 7857 (if (bound-and-true-p eww-auto-rename-buffer) 7858 (cl-loop for buf in (buffer-list) 7859 when (string-match-p "eww\\*\\'" (buffer-name buf)) 7860 return buf) 7861 (get-buffer "*eww*"))) 7862 7863 (defun markdown-visual-lines-between-points (beg end) 7864 (save-excursion 7865 (goto-char beg) 7866 (cl-loop with count = 0 7867 while (progn (end-of-visual-line) 7868 (and (< (point) end) (line-move-visual 1 t))) 7869 do (cl-incf count) 7870 finally return count))) 7871 7872 (defun markdown-live-preview-window-serialize (buf) 7873 "Get window point and scroll data for all windows displaying BUF." 7874 (when (buffer-live-p buf) 7875 (with-current-buffer buf 7876 (mapcar 7877 (lambda (win) 7878 (with-selected-window win 7879 (let* ((start (window-start)) 7880 (pt (window-point)) 7881 (pt-or-sym (cond ((= pt (point-min)) 'min) 7882 ((= pt (point-max)) 'max) 7883 (t pt))) 7884 (diff (markdown-visual-lines-between-points 7885 start pt))) 7886 (list win pt-or-sym diff)))) 7887 (get-buffer-window-list buf))))) 7888 7889 (defun markdown-get-point-back-lines (pt num-lines) 7890 (save-excursion 7891 (goto-char pt) 7892 (line-move-visual (- num-lines) t) 7893 ;; in testing, can occasionally overshoot the number of lines to traverse 7894 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) 7895 (when (> actual-num-lines num-lines) 7896 (line-move-visual (- actual-num-lines num-lines) t))) 7897 (point))) 7898 7899 (defun markdown-live-preview-window-deserialize (window-posns) 7900 "Apply window point and scroll data from WINDOW-POSNS. 7901 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." 7902 (cl-destructuring-bind (win pt-or-sym diff) window-posns 7903 (when (window-live-p win) 7904 (with-current-buffer markdown-live-preview-buffer 7905 (set-window-buffer win (current-buffer)) 7906 (cl-destructuring-bind (actual-pt actual-diff) 7907 (cl-case pt-or-sym 7908 (min (list (point-min) 0)) 7909 (max (list (point-max) diff)) 7910 (t (list pt-or-sym diff))) 7911 (set-window-start 7912 win (markdown-get-point-back-lines actual-pt actual-diff)) 7913 (set-window-point win actual-pt)))))) 7914 7915 (defun markdown-live-preview-export () 7916 "Export to XHTML using `markdown-export'. 7917 Browse the resulting file within Emacs using 7918 `markdown-live-preview-window-function' Return the buffer 7919 displaying the rendered output." 7920 (interactive) 7921 (let ((filename (markdown-live-preview-get-filename))) 7922 (when filename 7923 (let* ((markdown-live-preview-currently-exporting t) 7924 (cur-buf (current-buffer)) 7925 (export-file (markdown-export filename)) 7926 ;; get positions in all windows currently displaying output buffer 7927 (window-data 7928 (markdown-live-preview-window-serialize 7929 markdown-live-preview-buffer))) 7930 (save-window-excursion 7931 (let ((output-buffer 7932 (funcall markdown-live-preview-window-function export-file))) 7933 (with-current-buffer output-buffer 7934 (setq markdown-live-preview-source-buffer cur-buf) 7935 (add-hook 'kill-buffer-hook 7936 #'markdown-live-preview-remove-on-kill t t)) 7937 (with-current-buffer cur-buf 7938 (setq markdown-live-preview-buffer output-buffer)))) 7939 (with-current-buffer cur-buf 7940 ;; reset all windows displaying output buffer to where they were, 7941 ;; now with the new output 7942 (mapc #'markdown-live-preview-window-deserialize window-data) 7943 ;; delete html editing buffer 7944 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) 7945 (when (and export-file (file-exists-p export-file) 7946 (eq markdown-live-preview-delete-export 7947 'delete-on-export)) 7948 (delete-file export-file)) 7949 markdown-live-preview-buffer))))) 7950 7951 (defun markdown-live-preview-remove () 7952 (when (buffer-live-p markdown-live-preview-buffer) 7953 (kill-buffer markdown-live-preview-buffer)) 7954 (setq markdown-live-preview-buffer nil) 7955 ;; if set to 'delete-on-export, the output has already been deleted 7956 (when (eq markdown-live-preview-delete-export 'delete-on-destroy) 7957 (let ((outfile-name (markdown-live-preview-get-filename))) 7958 (when (and outfile-name (file-exists-p outfile-name)) 7959 (delete-file outfile-name))))) 7960 7961 (defun markdown-get-other-window () 7962 "Find another window to display preview or output content." 7963 (cond 7964 ((memq markdown-split-window-direction '(vertical below)) 7965 (or (window-in-direction 'below) (split-window-vertically))) 7966 ((memq markdown-split-window-direction '(horizontal right)) 7967 (or (window-in-direction 'right) (split-window-horizontally))) 7968 (t (split-window-sensibly (get-buffer-window))))) 7969 7970 (defun markdown-display-buffer-other-window (buf) 7971 "Display preview or output buffer BUF in another window." 7972 (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) 7973 (display-buffer buf) 7974 (let ((cur-buf (current-buffer)) 7975 (window (markdown-get-other-window))) 7976 (set-window-buffer window buf) 7977 (set-buffer cur-buf)))) 7978 7979 (defun markdown-live-preview-if-markdown () 7980 (when (and (derived-mode-p 'markdown-mode) 7981 markdown-live-preview-mode) 7982 (unless markdown-live-preview-currently-exporting 7983 (if (buffer-live-p markdown-live-preview-buffer) 7984 (markdown-live-preview-export) 7985 (markdown-display-buffer-other-window 7986 (markdown-live-preview-export)))))) 7987 7988 (defun markdown-live-preview-remove-on-kill () 7989 (cond ((and (derived-mode-p 'markdown-mode) 7990 markdown-live-preview-mode) 7991 (markdown-live-preview-remove)) 7992 (markdown-live-preview-source-buffer 7993 (with-current-buffer markdown-live-preview-source-buffer 7994 (setq markdown-live-preview-buffer nil)) 7995 (setq markdown-live-preview-source-buffer nil)))) 7996 7997 (defun markdown-live-preview-switch-to-output () 7998 "Turn on `markdown-live-preview-mode' and switch to output buffer. 7999 The output buffer is opened in another window." 8000 (interactive) 8001 (if markdown-live-preview-mode 8002 (markdown-display-buffer-other-window (markdown-live-preview-export))) 8003 (markdown-live-preview-mode)) 8004 8005 (defun markdown-live-preview-re-export () 8006 "Re-export the current live previewed content. 8007 If the current buffer is a buffer displaying the exported version of a 8008 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and 8009 update this buffer's contents." 8010 (interactive) 8011 (when markdown-live-preview-source-buffer 8012 (with-current-buffer markdown-live-preview-source-buffer 8013 (markdown-live-preview-export)))) 8014 8015 (defun markdown-open () 8016 "Open file for the current buffer with `markdown-open-command'." 8017 (interactive) 8018 (unless markdown-open-command 8019 (user-error "Variable `markdown-open-command' must be set")) 8020 (if (stringp markdown-open-command) 8021 (if (not buffer-file-name) 8022 (user-error "Must be visiting a file") 8023 (save-buffer) 8024 (let ((exit-code (call-process markdown-open-command nil nil nil 8025 buffer-file-name))) 8026 ;; The exit code can be a signal description string, so don’t use ‘=’ 8027 ;; or ‘zerop’. 8028 (unless (eq exit-code 0) 8029 (user-error "%s failed with exit code %s" 8030 markdown-open-command exit-code)))) 8031 (funcall markdown-open-command)) 8032 nil) 8033 8034 (defun markdown-kill-ring-save () 8035 "Run Markdown on file and store output in the kill ring." 8036 (interactive) 8037 (save-window-excursion 8038 (markdown) 8039 (with-current-buffer markdown-output-buffer-name 8040 (kill-ring-save (point-min) (point-max))))) 8041 8042 8043 ;;; Links ===================================================================== 8044 8045 (defun markdown-backward-to-link-start () 8046 "Backward link start position if current position is in link title." 8047 ;; Issue #305 8048 (when (eq (get-text-property (point) 'face) 'markdown-link-face) 8049 (skip-chars-backward "^[") 8050 (forward-char -1))) 8051 8052 (defun markdown-link-p () 8053 "Return non-nil when `point' is at a non-wiki link. 8054 See `markdown-wiki-link-p' for more information." 8055 (save-excursion 8056 (let ((case-fold-search nil)) 8057 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) 8058 (markdown-backward-to-link-start) 8059 (or (thing-at-point-looking-at markdown-regex-link-inline) 8060 (thing-at-point-looking-at markdown-regex-link-reference) 8061 (thing-at-point-looking-at markdown-regex-uri) 8062 (thing-at-point-looking-at markdown-regex-angle-uri)))))) 8063 8064 (defun markdown-link-at-pos (pos) 8065 "Return properties of link or image at position POS. 8066 Value is a list of elements describing the link: 8067 0. beginning position 8068 1. end position 8069 2. link text 8070 3. URL 8071 4. reference label 8072 5. title text 8073 6. bang (nil or \"!\")" 8074 (save-excursion 8075 (goto-char pos) 8076 (markdown-backward-to-link-start) 8077 (let (begin end text url reference title bang) 8078 (cond 8079 ;; Inline image or link at point. 8080 ((thing-at-point-looking-at markdown-regex-link-inline) 8081 (setq bang (match-string-no-properties 1) 8082 begin (match-beginning 0) 8083 text (match-string-no-properties 3) 8084 url (match-string-no-properties 6)) 8085 ;; consider nested parentheses 8086 ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link 8087 (let* ((close-pos (scan-sexps (match-beginning 5) 1)) 8088 (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) 8089 (setq end close-pos) 8090 ;; A link can contain spaces if it is wrapped with angle brackets 8091 (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) 8092 (setq url (match-string-no-properties 1 destination-part))) 8093 ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) 8094 (setq url (match-string-no-properties 1 destination-part) 8095 title (substring (match-string-no-properties 2 destination-part) 1 -1))) 8096 (t (setq url destination-part))) 8097 (setq url (url-unhex-string url)))) 8098 ;; Reference link at point. 8099 ((thing-at-point-looking-at markdown-regex-link-reference) 8100 (setq bang (match-string-no-properties 1) 8101 begin (match-beginning 0) 8102 end (match-end 0) 8103 text (match-string-no-properties 3)) 8104 (when (char-equal (char-after (match-beginning 5)) ?\[) 8105 (setq reference (match-string-no-properties 6)))) 8106 ;; Angle bracket URI at point. 8107 ((thing-at-point-looking-at markdown-regex-angle-uri) 8108 (setq begin (match-beginning 0) 8109 end (match-end 0) 8110 url (match-string-no-properties 2))) 8111 ;; Plain URI at point. 8112 ((thing-at-point-looking-at markdown-regex-uri) 8113 (setq begin (match-beginning 0) 8114 end (match-end 0) 8115 url (match-string-no-properties 1)))) 8116 (list begin end text url reference title bang)))) 8117 8118 (defun markdown-link-url () 8119 "Return the URL part of the regular (non-wiki) link at point. 8120 Works with both inline and reference style links, and with images. 8121 If point is not at a link or the link reference is not defined 8122 returns nil." 8123 (let* ((values (markdown-link-at-pos (point))) 8124 (text (nth 2 values)) 8125 (url (nth 3 values)) 8126 (ref (nth 4 values))) 8127 (or url (and ref (car (markdown-reference-definition 8128 (downcase (if (string= ref "") text ref)))))))) 8129 8130 (defun markdown--browse-url (url) 8131 (let* ((struct (url-generic-parse-url url)) 8132 (full (url-fullness struct)) 8133 (file url)) 8134 ;; Parse URL, determine fullness, strip query string 8135 (setq file (car (url-path-and-query struct))) 8136 ;; Open full URLs in browser, files in Emacs 8137 (if full 8138 (browse-url url) 8139 (when (and file (> (length file) 0)) 8140 (let ((link-file (funcall markdown-translate-filename-function file))) 8141 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) 8142 (if (functionp markdown-open-image-command) 8143 (funcall markdown-open-image-command link-file) 8144 (process-file markdown-open-image-command nil nil nil link-file)) 8145 (find-file link-file))))))) 8146 8147 (defun markdown-follow-link-at-point (&optional event) 8148 "Open the non-wiki link at point or EVENT. 8149 If the link is a complete URL, open in browser with `browse-url'. 8150 Otherwise, open with `find-file' after stripping anchor and/or query string. 8151 Translate filenames using `markdown-filename-translate-function'." 8152 (interactive (list last-command-event)) 8153 (if event (posn-set-point (event-start event))) 8154 (if (markdown-link-p) 8155 (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) 8156 (markdown--browse-url (markdown-link-url))) 8157 (user-error "Point is not at a Markdown link or URL"))) 8158 8159 (defun markdown-fontify-inline-links (last) 8160 "Add text properties to next inline link from point to LAST." 8161 (when (markdown-match-generic-links last nil) 8162 (let* ((link-start (match-beginning 3)) 8163 (link-end (match-end 3)) 8164 (url-start (match-beginning 6)) 8165 (url-end (match-end 6)) 8166 (url (match-string-no-properties 6)) 8167 (title-start (match-beginning 7)) 8168 (title-end (match-end 7)) 8169 (title (match-string-no-properties 7)) 8170 ;; Markup part 8171 (mp (list 'invisible 'markdown-markup 8172 'rear-nonsticky t 8173 'font-lock-multiline t)) 8174 ;; Link part (without face) 8175 (lp (list 'keymap markdown-mode-mouse-map 8176 'mouse-face 'markdown-highlight-face 8177 'font-lock-multiline t 8178 'help-echo (if title (concat title "\n" url) url))) 8179 ;; URL part 8180 (up (list 'keymap markdown-mode-mouse-map 8181 'invisible 'markdown-markup 8182 'mouse-face 'markdown-highlight-face 8183 'font-lock-multiline t)) 8184 ;; URL composition character 8185 (url-char (markdown--first-displayable markdown-url-compose-char)) 8186 ;; Title part 8187 (tp (list 'invisible 'markdown-markup 8188 'font-lock-multiline t))) 8189 (dolist (g '(1 2 4 5 8)) 8190 (when (match-end g) 8191 (add-text-properties (match-beginning g) (match-end g) mp) 8192 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8193 ;; Preserve existing faces applied to link part (e.g., inline code) 8194 (when link-start 8195 (add-text-properties link-start link-end lp) 8196 (add-face-text-property link-start link-end 'markdown-link-face)) 8197 (when url-start 8198 (add-text-properties url-start url-end up) 8199 (add-face-text-property url-start url-end 'markdown-url-face)) 8200 (when title-start 8201 (add-text-properties url-end title-end tp) 8202 (add-face-text-property url-end title-end 'markdown-link-title-face)) 8203 (when (and markdown-hide-urls url-start) 8204 (compose-region url-start (or title-end url-end) url-char)) 8205 t))) 8206 8207 (defun markdown-fontify-reference-links (last) 8208 "Add text properties to next reference link from point to LAST." 8209 (when (markdown-match-generic-links last t) 8210 (let* ((link-start (match-beginning 3)) 8211 (link-end (match-end 3)) 8212 (ref-start (match-beginning 6)) 8213 (ref-end (match-end 6)) 8214 ;; Markup part 8215 (mp (list 'invisible 'markdown-markup 8216 'rear-nonsticky t 8217 'font-lock-multiline t)) 8218 ;; Link part 8219 (lp (list 'keymap markdown-mode-mouse-map 8220 'mouse-face 'markdown-highlight-face 8221 'font-lock-multiline t 8222 'help-echo (lambda (_ __ pos) 8223 (save-match-data 8224 (save-excursion 8225 (goto-char pos) 8226 (or (markdown-link-url) 8227 "Undefined reference")))))) 8228 ;; URL composition character 8229 (url-char (markdown--first-displayable markdown-url-compose-char)) 8230 ;; Reference part 8231 (rp (list 'invisible 'markdown-markup 8232 'font-lock-multiline t))) 8233 (dolist (g '(1 2 4 5 8)) 8234 (when (match-end g) 8235 (add-text-properties (match-beginning g) (match-end g) mp) 8236 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8237 (when link-start 8238 (add-text-properties link-start link-end lp) 8239 (add-face-text-property link-start link-end 'markdown-link-face)) 8240 (when ref-start 8241 (add-text-properties ref-start ref-end rp) 8242 (add-face-text-property ref-start ref-end 'markdown-reference-face) 8243 (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) 8244 (compose-region ref-start ref-end url-char))) 8245 t))) 8246 8247 (defun markdown-fontify-angle-uris (last) 8248 "Add text properties to angle URIs from point to LAST." 8249 (when (markdown-match-angle-uris last) 8250 (let* ((url-start (match-beginning 2)) 8251 (url-end (match-end 2)) 8252 ;; Markup part 8253 (mp (list 'face 'markdown-markup-face 8254 'invisible 'markdown-markup 8255 'rear-nonsticky t 8256 'font-lock-multiline t)) 8257 ;; URI part 8258 (up (list 'keymap markdown-mode-mouse-map 8259 'face 'markdown-plain-url-face 8260 'mouse-face 'markdown-highlight-face 8261 'font-lock-multiline t))) 8262 (dolist (g '(1 3)) 8263 (add-text-properties (match-beginning g) (match-end g) mp)) 8264 (add-text-properties url-start url-end up) 8265 t))) 8266 8267 (defun markdown-fontify-plain-uris (last) 8268 "Add text properties to plain URLs from point to LAST." 8269 (when (markdown-match-plain-uris last) 8270 (let* ((start (match-beginning 0)) 8271 (end (match-end 0)) 8272 (props (list 'keymap markdown-mode-mouse-map 8273 'face 'markdown-plain-url-face 8274 'mouse-face 'markdown-highlight-face 8275 'rear-nonsticky t 8276 'font-lock-multiline t))) 8277 (add-text-properties start end props) 8278 t))) 8279 8280 (defun markdown-toggle-url-hiding (&optional arg) 8281 "Toggle the display or hiding of URLs. 8282 With a prefix argument ARG, enable URL hiding if ARG is positive, 8283 and disable it otherwise." 8284 (interactive (list (or current-prefix-arg 'toggle))) 8285 (setq markdown-hide-urls 8286 (if (eq arg 'toggle) 8287 (not markdown-hide-urls) 8288 (> (prefix-numeric-value arg) 0))) 8289 (if markdown-hide-urls 8290 (message "markdown-mode URL hiding enabled") 8291 (message "markdown-mode URL hiding disabled")) 8292 (markdown-reload-extensions)) 8293 8294 8295 ;;; Wiki Links ================================================================ 8296 8297 (defun markdown-wiki-link-p () 8298 "Return non-nil if wiki links are enabled and `point' is at a true wiki link. 8299 A true wiki link name matches `markdown-regex-wiki-link' but does 8300 not match the current file name after conversion. This modifies 8301 the data returned by `match-data'. Note that the potential wiki 8302 link name must be available via `match-string'." 8303 (when markdown-enable-wiki-links 8304 (let ((case-fold-search nil)) 8305 (and (thing-at-point-looking-at markdown-regex-wiki-link) 8306 (not (markdown-code-block-at-point-p)) 8307 (or (not buffer-file-name) 8308 (not (string-equal (buffer-file-name) 8309 (markdown-convert-wiki-link-to-filename 8310 (markdown-wiki-link-link))))))))) 8311 8312 (defun markdown-wiki-link-link () 8313 "Return the link part of the wiki link using current match data. 8314 The location of the link component depends on the value of 8315 `markdown-wiki-link-alias-first'." 8316 (if markdown-wiki-link-alias-first 8317 (or (match-string-no-properties 5) (match-string-no-properties 3)) 8318 (match-string-no-properties 3))) 8319 8320 (defun markdown-wiki-link-alias () 8321 "Return the alias or text part of the wiki link using current match data. 8322 The location of the alias component depends on the value of 8323 `markdown-wiki-link-alias-first'." 8324 (if markdown-wiki-link-alias-first 8325 (match-string-no-properties 3) 8326 (or (match-string-no-properties 5) (match-string-no-properties 3)))) 8327 8328 (defun markdown--wiki-link-search-types () 8329 (let ((ret (and markdown-wiki-link-search-type 8330 (cl-copy-list markdown-wiki-link-search-type)))) 8331 (when (and markdown-wiki-link-search-subdirectories 8332 (not (memq 'sub-directories markdown-wiki-link-search-type))) 8333 (push 'sub-directories ret)) 8334 (when (and markdown-wiki-link-search-parent-directories 8335 (not (memq 'parent-directories markdown-wiki-link-search-type))) 8336 (push 'parent-directories ret)) 8337 ret)) 8338 8339 (defun markdown--project-root () 8340 (or (cl-loop for dir in '(".git" ".hg" ".svn") 8341 when (locate-dominating-file default-directory dir) 8342 return it) 8343 (progn 8344 (require 'project) 8345 (let ((project (project-current t))) 8346 (with-no-warnings 8347 (if (fboundp 'project-root) 8348 (project-root project) 8349 (car (project-roots project)))))))) 8350 8351 (defun markdown-convert-wiki-link-to-filename (name) 8352 "Generate a filename from the wiki link NAME. 8353 Spaces in NAME are replaced with `markdown-link-space-sub-char'. 8354 When in `gfm-mode', follow GitHub's conventions where [[Test Test]] 8355 and [[test test]] both map to Test-test.ext. Look in the current 8356 directory first, then in subdirectories if 8357 `markdown-wiki-link-search-subdirectories' is non-nil, and then 8358 in parent directories if 8359 `markdown-wiki-link-search-parent-directories' is non-nil." 8360 (save-match-data 8361 ;; This function must not overwrite match data(PR #590) 8362 (let* ((basename (replace-regexp-in-string 8363 "[[:space:]\n]" markdown-link-space-sub-char name)) 8364 (basename (if (derived-mode-p 'gfm-mode) 8365 (concat (upcase (substring basename 0 1)) 8366 (downcase (substring basename 1 nil))) 8367 basename)) 8368 (search-types (markdown--wiki-link-search-types)) 8369 directory extension default candidates dir) 8370 (when buffer-file-name 8371 (setq directory (file-name-directory buffer-file-name) 8372 extension (file-name-extension buffer-file-name))) 8373 (setq default (concat basename 8374 (when extension (concat "." extension)))) 8375 (cond 8376 ;; Look in current directory first. 8377 ((or (null buffer-file-name) 8378 (file-exists-p default)) 8379 default) 8380 ;; Possibly search in subdirectories, next. 8381 ((and (memq 'sub-directories search-types) 8382 (setq candidates 8383 (directory-files-recursively 8384 directory (concat "^" default "$")))) 8385 (car candidates)) 8386 ;; Possibly search in parent directories as a last resort. 8387 ((and (memq 'parent-directories search-types) 8388 (setq dir (locate-dominating-file directory default))) 8389 (concat dir default)) 8390 ((and (memq 'project search-types) 8391 (setq candidates 8392 (directory-files-recursively 8393 (markdown--project-root) (concat "^" default "$")))) 8394 (car candidates)) 8395 ;; If nothing is found, return default in current directory. 8396 (t default))))) 8397 8398 (defun markdown-follow-wiki-link (name &optional other) 8399 "Follow the wiki link NAME. 8400 Convert the name to a file name and call `find-file'. Ensure that 8401 the new buffer remains in `markdown-mode'. Open the link in another 8402 window when OTHER is non-nil." 8403 (let ((filename (markdown-convert-wiki-link-to-filename name)) 8404 (wp (when buffer-file-name 8405 (file-name-directory buffer-file-name)))) 8406 (if (not wp) 8407 (user-error "Must be visiting a file") 8408 (when other (other-window 1)) 8409 (let ((default-directory wp)) 8410 (find-file filename))) 8411 (unless (derived-mode-p 'markdown-mode) 8412 (markdown-mode)))) 8413 8414 (defun markdown-follow-wiki-link-at-point (&optional arg) 8415 "Find Wiki Link at point. 8416 With prefix argument ARG, open the file in other window. 8417 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." 8418 (interactive "P") 8419 (if (markdown-wiki-link-p) 8420 (markdown-follow-wiki-link (markdown-wiki-link-link) arg) 8421 (user-error "Point is not at a Wiki Link"))) 8422 8423 (defun markdown-highlight-wiki-link (from to face) 8424 "Highlight the wiki link in the region between FROM and TO using FACE." 8425 (put-text-property from to 'font-lock-face face)) 8426 8427 (defun markdown-unfontify-region-wiki-links (from to) 8428 "Remove wiki link faces from the region specified by FROM and TO." 8429 (interactive "*r") 8430 (let ((modified (buffer-modified-p))) 8431 (remove-text-properties from to '(font-lock-face markdown-link-face)) 8432 (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) 8433 ;; remove-text-properties marks the buffer modified in emacs 24.3, 8434 ;; undo that if it wasn't originally marked modified 8435 (set-buffer-modified-p modified))) 8436 8437 (defun markdown-fontify-region-wiki-links (from to) 8438 "Search region given by FROM and TO for wiki links and fontify them. 8439 If a wiki link is found check to see if the backing file exists 8440 and highlight accordingly." 8441 (goto-char from) 8442 (save-match-data 8443 (while (re-search-forward markdown-regex-wiki-link to t) 8444 (when (not (markdown-code-block-at-point-p)) 8445 (let ((highlight-beginning (match-beginning 1)) 8446 (highlight-end (match-end 1)) 8447 (file-name 8448 (markdown-convert-wiki-link-to-filename 8449 (markdown-wiki-link-link)))) 8450 (if (condition-case nil (file-exists-p file-name) (error nil)) 8451 (markdown-highlight-wiki-link 8452 highlight-beginning highlight-end 'markdown-link-face) 8453 (markdown-highlight-wiki-link 8454 highlight-beginning highlight-end 'markdown-missing-link-face))))))) 8455 8456 (defun markdown-extend-changed-region (from to) 8457 "Extend region given by FROM and TO so that we can fontify all links. 8458 The region is extended to the first newline before and the first 8459 newline after." 8460 ;; start looking for the first new line before 'from 8461 (goto-char from) 8462 (re-search-backward "\n" nil t) 8463 (let ((new-from (point-min)) 8464 (new-to (point-max))) 8465 (if (not (= (point) from)) 8466 (setq new-from (point))) 8467 ;; do the same thing for the first new line after 'to 8468 (goto-char to) 8469 (re-search-forward "\n" nil t) 8470 (if (not (= (point) to)) 8471 (setq new-to (point))) 8472 (cl-values new-from new-to))) 8473 8474 (defun markdown-check-change-for-wiki-link (from to) 8475 "Check region between FROM and TO for wiki links and re-fontify as needed." 8476 (interactive "*r") 8477 (let* ((modified (buffer-modified-p)) 8478 (buffer-undo-list t) 8479 (inhibit-read-only t) 8480 deactivate-mark 8481 buffer-file-truename) 8482 (unwind-protect 8483 (save-excursion 8484 (save-match-data 8485 (save-restriction 8486 (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 8487 ;; Extend the region to fontify so that it starts 8488 ;; and ends at safe places. 8489 (cl-multiple-value-bind (new-from new-to) 8490 (markdown-extend-changed-region from to) 8491 (goto-char new-from) 8492 ;; Only refontify when the range contains text with a 8493 ;; wiki link face or if the wiki link regexp matches. 8494 (when (or (markdown-range-property-any 8495 new-from new-to 'font-lock-face 8496 '(markdown-link-face markdown-missing-link-face)) 8497 (re-search-forward 8498 markdown-regex-wiki-link new-to t)) 8499 ;; Unfontify existing fontification (start from scratch) 8500 (markdown-unfontify-region-wiki-links new-from new-to) 8501 ;; Now do the fontification. 8502 (markdown-fontify-region-wiki-links new-from new-to)))))) 8503 (cursor-intangible-mode -1) 8504 (and (not modified) 8505 (buffer-modified-p) 8506 (set-buffer-modified-p nil))))) 8507 8508 (defun markdown-check-change-for-wiki-link-after-change (from to _) 8509 "Check region between FROM and TO for wiki links and re-fontify as needed. 8510 Designed to be used with the `after-change-functions' hook." 8511 (markdown-check-change-for-wiki-link from to)) 8512 8513 (defun markdown-fontify-buffer-wiki-links () 8514 "Refontify all wiki links in the buffer." 8515 (interactive) 8516 (markdown-check-change-for-wiki-link (point-min) (point-max))) 8517 8518 (defun markdown-toggle-wiki-links (&optional arg) 8519 "Toggle support for wiki links. 8520 With a prefix argument ARG, enable wiki link support if ARG is positive, 8521 and disable it otherwise." 8522 (interactive (list (or current-prefix-arg 'toggle))) 8523 (setq markdown-enable-wiki-links 8524 (if (eq arg 'toggle) 8525 (not markdown-enable-wiki-links) 8526 (> (prefix-numeric-value arg) 0))) 8527 (if markdown-enable-wiki-links 8528 (message "markdown-mode wiki link support enabled") 8529 (message "markdown-mode wiki link support disabled")) 8530 (markdown-reload-extensions)) 8531 8532 (defun markdown-setup-wiki-link-hooks () 8533 "Add or remove hooks for fontifying wiki links. 8534 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." 8535 ;; Anytime text changes make sure it gets fontified correctly 8536 (if (and markdown-enable-wiki-links 8537 markdown-wiki-link-fontify-missing) 8538 (add-hook 'after-change-functions 8539 #'markdown-check-change-for-wiki-link-after-change t t) 8540 (remove-hook 'after-change-functions 8541 #'markdown-check-change-for-wiki-link-after-change t)) 8542 ;; If we left the buffer there is a really good chance we were 8543 ;; creating one of the wiki link documents. Make sure we get 8544 ;; refontified when we come back. 8545 (if (and markdown-enable-wiki-links 8546 markdown-wiki-link-fontify-missing) 8547 (progn 8548 (add-hook 'window-configuration-change-hook 8549 #'markdown-fontify-buffer-wiki-links t t) 8550 (markdown-fontify-buffer-wiki-links)) 8551 (remove-hook 'window-configuration-change-hook 8552 #'markdown-fontify-buffer-wiki-links t) 8553 (markdown-unfontify-region-wiki-links (point-min) (point-max)))) 8554 8555 8556 ;;; Following & Doing ========================================================= 8557 8558 (defun markdown-follow-thing-at-point (arg) 8559 "Follow thing at point if possible, such as a reference link or wiki link. 8560 Opens inline and reference links in a browser. Opens wiki links 8561 to other files in the current window, or the another window if 8562 ARG is non-nil. 8563 See `markdown-follow-link-at-point' and 8564 `markdown-follow-wiki-link-at-point'." 8565 (interactive "P") 8566 (cond ((markdown-link-p) 8567 (markdown-follow-link-at-point)) 8568 ((markdown-wiki-link-p) 8569 (markdown-follow-wiki-link-at-point arg)) 8570 (t 8571 (let* ((values (markdown-link-at-pos (point))) 8572 (url (nth 3 values))) 8573 (unless url 8574 (user-error "Nothing to follow at point")) 8575 (markdown--browse-url url))))) 8576 8577 (defun markdown-do () 8578 "Do something sensible based on context at point. 8579 Jumps between reference links and definitions; between footnote 8580 markers and footnote text." 8581 (interactive) 8582 (cond 8583 ;; Footnote definition 8584 ((markdown-footnote-text-positions) 8585 (markdown-footnote-return)) 8586 ;; Footnote marker 8587 ((markdown-footnote-marker-positions) 8588 (markdown-footnote-goto-text)) 8589 ;; Reference link 8590 ((thing-at-point-looking-at markdown-regex-link-reference) 8591 (markdown-reference-goto-definition)) 8592 ;; Reference definition 8593 ((thing-at-point-looking-at markdown-regex-reference-definition) 8594 (markdown-reference-goto-link (match-string-no-properties 2))) 8595 ;; Link 8596 ((or (markdown-link-p) (markdown-wiki-link-p)) 8597 (markdown-follow-thing-at-point nil)) 8598 ;; GFM task list item 8599 ((markdown-gfm-task-list-item-at-point) 8600 (markdown-toggle-gfm-checkbox)) 8601 ;; Align table 8602 ((markdown-table-at-point-p) 8603 (call-interactively #'markdown-table-align)) 8604 ;; Otherwise 8605 (t 8606 (markdown-insert-gfm-checkbox)))) 8607 8608 8609 ;;; Miscellaneous ============================================================= 8610 8611 (defun markdown-compress-whitespace-string (str) 8612 "Compress whitespace in STR and return result. 8613 Leading and trailing whitespace is removed. Sequences of multiple 8614 spaces, tabs, and newlines are replaced with single spaces." 8615 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" 8616 (replace-regexp-in-string "[ \t\n]+" " " str))) 8617 8618 (defun markdown--substitute-command-keys (string) 8619 "Like `substitute-command-keys' but, but prefers control characters. 8620 First pass STRING to `substitute-command-keys' and then 8621 substitute `C-i` for `TAB` and `C-m` for `RET`." 8622 (replace-regexp-in-string 8623 "\\<TAB\\>" "C-i" 8624 (replace-regexp-in-string 8625 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) 8626 8627 (defun markdown-line-number-at-pos (&optional pos) 8628 "Return (narrowed) buffer line number at position POS. 8629 If POS is nil, use current buffer location. 8630 This is an exact copy of `line-number-at-pos' for use in emacs21." 8631 (let ((opoint (or pos (point))) start) 8632 (save-excursion 8633 (goto-char (point-min)) 8634 (setq start (point)) 8635 (goto-char opoint) 8636 (forward-line 0) 8637 (1+ (count-lines start (point)))))) 8638 8639 (defun markdown-inside-link-p () 8640 "Return t if point is within a link." 8641 (save-match-data 8642 (thing-at-point-looking-at (markdown-make-regex-link-generic)))) 8643 8644 (defun markdown-line-is-reference-definition-p () 8645 "Return whether the current line is a (non-footnote) reference definition." 8646 (save-excursion 8647 (move-beginning-of-line 1) 8648 (and (looking-at-p markdown-regex-reference-definition) 8649 (not (looking-at-p "[ \t]*\\[^"))))) 8650 8651 (defun markdown-adaptive-fill-function () 8652 "Return prefix for filling paragraph or nil if not determined." 8653 (cond 8654 ;; List item inside blockquote 8655 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") 8656 (replace-regexp-in-string 8657 "[0-9\\.*+-]" " " (match-string-no-properties 0))) 8658 ;; Blockquote 8659 ((looking-at markdown-regex-blockquote) 8660 (buffer-substring-no-properties (match-beginning 0) (match-end 2))) 8661 ;; List items 8662 ((looking-at markdown-regex-list) 8663 (match-string-no-properties 0)) 8664 ;; Footnote definition 8665 ((looking-at-p markdown-regex-footnote-definition) 8666 " ") ; four spaces 8667 ;; No match 8668 (t nil))) 8669 8670 (defun markdown-fill-paragraph (&optional justify) 8671 "Fill paragraph at or after point. 8672 This function is like \\[fill-paragraph], but it skips Markdown 8673 code blocks. If the point is in a code block, or just before one, 8674 do not fill. Otherwise, call `fill-paragraph' as usual. If 8675 JUSTIFY is non-nil, justify text as well. Since this function 8676 handles filling itself, it always returns t so that 8677 `fill-paragraph' doesn't run." 8678 (interactive "P") 8679 (unless (or (markdown-code-block-at-point-p) 8680 (save-excursion 8681 (back-to-indentation) 8682 (skip-syntax-forward "-") 8683 (markdown-code-block-at-point-p))) 8684 (let ((fill-prefix (save-excursion 8685 (goto-char (line-beginning-position)) 8686 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") 8687 (match-string-no-properties 1))))) 8688 (fill-paragraph justify))) 8689 t) 8690 8691 (defun markdown-fill-forward-paragraph (&optional arg) 8692 "Function used by `fill-paragraph' to move over ARG paragraphs. 8693 This is a `fill-forward-paragraph-function' for `markdown-mode'. 8694 It is called with a single argument specifying the number of 8695 paragraphs to move. Just like `forward-paragraph', it should 8696 return the number of paragraphs left to move." 8697 (or arg (setq arg 1)) 8698 (if (> arg 0) 8699 ;; With positive ARG, move across ARG non-code-block paragraphs, 8700 ;; one at a time. When passing a code block, don't decrement ARG. 8701 (while (and (not (eobp)) 8702 (> arg 0) 8703 (= (forward-paragraph 1) 0) 8704 (or (markdown-code-block-at-pos (line-beginning-position 0)) 8705 (setq arg (1- arg))))) 8706 ;; Move backward by one paragraph with negative ARG (always -1). 8707 (let ((start (point))) 8708 (setq arg (forward-paragraph arg)) 8709 (while (and (not (eobp)) 8710 (progn (move-to-left-margin) (not (eobp))) 8711 (looking-at-p paragraph-separate)) 8712 (forward-line 1)) 8713 (cond 8714 ;; Move point past whitespace following list marker. 8715 ((looking-at markdown-regex-list) 8716 (goto-char (match-end 0))) 8717 ;; Move point past whitespace following pipe at beginning of line 8718 ;; to handle Pandoc line blocks. 8719 ((looking-at "^|\\s-*") 8720 (goto-char (match-end 0))) 8721 ;; Return point if the paragraph passed was a code block. 8722 ((markdown-code-block-at-pos (line-beginning-position 2)) 8723 (goto-char start))))) 8724 arg) 8725 8726 (defun markdown--inhibit-electric-quote () 8727 "Function added to `electric-quote-inhibit-functions'. 8728 Return non-nil if the quote has been inserted inside a code block 8729 or span." 8730 (let ((pos (1- (point)))) 8731 (or (markdown-inline-code-at-pos pos) 8732 (markdown-code-block-at-pos pos)))) 8733 8734 8735 ;;; Extension Framework ======================================================= 8736 8737 (defun markdown-reload-extensions () 8738 "Check settings, update font-lock keywords and hooks, and re-fontify buffer." 8739 (interactive) 8740 (when (derived-mode-p 'markdown-mode) 8741 ;; Refontify buffer 8742 (font-lock-flush) 8743 ;; Add or remove hooks related to extensions 8744 (markdown-setup-wiki-link-hooks))) 8745 8746 (defun markdown-handle-local-variables () 8747 "Run in `hack-local-variables-hook' to update font lock rules. 8748 Checks to see if there is actually a ‘markdown-mode’ file local variable 8749 before regenerating font-lock rules for extensions." 8750 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) 8751 (assoc 'markdown-enable-math file-local-variables-alist)) 8752 (when (assoc 'markdown-enable-math file-local-variables-alist) 8753 (markdown-toggle-math markdown-enable-math)) 8754 (markdown-reload-extensions))) 8755 8756 8757 ;;; Math Support ============================================================== 8758 8759 (defconst markdown-mode-font-lock-keywords-math 8760 (list 8761 ;; Equation reference (eq:foo) 8762 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) 8763 (2 markdown-reference-face) 8764 (3 markdown-markup-face))) 8765 ;; Equation reference \eqref{foo} 8766 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) 8767 (2 markdown-reference-face) 8768 (3 markdown-markup-face)))) 8769 "Font lock keywords to add and remove when toggling math support.") 8770 8771 (defun markdown-toggle-math (&optional arg) 8772 "Toggle support for inline and display LaTeX math expressions. 8773 With a prefix argument ARG, enable math mode if ARG is positive, 8774 and disable it otherwise. If called from Lisp, enable the mode 8775 if ARG is omitted or nil." 8776 (interactive (list (or current-prefix-arg 'toggle))) 8777 (setq markdown-enable-math 8778 (if (eq arg 'toggle) 8779 (not markdown-enable-math) 8780 (> (prefix-numeric-value arg) 0))) 8781 (if markdown-enable-math 8782 (progn 8783 (font-lock-add-keywords 8784 'markdown-mode markdown-mode-font-lock-keywords-math) 8785 (message "markdown-mode math support enabled")) 8786 (font-lock-remove-keywords 8787 'markdown-mode markdown-mode-font-lock-keywords-math) 8788 (message "markdown-mode math support disabled")) 8789 (markdown-reload-extensions)) 8790 8791 8792 ;;; GFM Checkboxes ============================================================ 8793 8794 (define-button-type 'markdown-gfm-checkbox-button 8795 'follow-link t 8796 'face 'markdown-gfm-checkbox-face 8797 'mouse-face 'markdown-highlight-face 8798 'action #'markdown-toggle-gfm-checkbox-button) 8799 8800 (defun markdown-gfm-task-list-item-at-point (&optional bounds) 8801 "Return non-nil if there is a GFM task list item at the point. 8802 Optionally, the list item BOUNDS may be given if available, as 8803 returned by `markdown-cur-list-item-bounds'. When a task list item 8804 is found, the return value is the same value returned by 8805 `markdown-cur-list-item-bounds'." 8806 (unless bounds 8807 (setq bounds (markdown-cur-list-item-bounds))) 8808 (> (length (nth 5 bounds)) 0)) 8809 8810 (defun markdown-insert-gfm-checkbox () 8811 "Add GFM checkbox at point. 8812 Returns t if added. 8813 Returns nil if non-applicable." 8814 (interactive) 8815 (let ((bounds (markdown-cur-list-item-bounds))) 8816 (if bounds 8817 (unless (cl-sixth bounds) 8818 (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) 8819 (markup "[ ] ")) 8820 (if (< pos (point)) 8821 (save-excursion 8822 (goto-char pos) 8823 (insert markup)) 8824 (goto-char pos) 8825 (insert markup)) 8826 (syntax-propertize (+ (cl-second bounds) 4)) 8827 t)) 8828 (unless (save-excursion 8829 (back-to-indentation) 8830 (or (markdown-list-item-at-point-p) 8831 (markdown-heading-at-point) 8832 (markdown-in-comment-p) 8833 (markdown-code-block-at-point-p))) 8834 (let ((pos (save-excursion 8835 (back-to-indentation) 8836 (point))) 8837 (markup (concat (or (save-excursion 8838 (beginning-of-line 0) 8839 (cl-fifth (markdown-cur-list-item-bounds))) 8840 markdown-unordered-list-item-prefix) 8841 "[ ] "))) 8842 (if (< pos (point)) 8843 (save-excursion 8844 (goto-char pos) 8845 (insert markup)) 8846 (goto-char pos) 8847 (insert markup)) 8848 (syntax-propertize (line-end-position)) 8849 t))))) 8850 8851 (defun markdown-toggle-gfm-checkbox () 8852 "Toggle GFM checkbox at point. 8853 Returns the resulting status as a string, either \"[x]\" or \"[ ]\". 8854 Returns nil if there is no task list item at the point." 8855 (interactive) 8856 (save-match-data 8857 (save-excursion 8858 (let ((bounds (markdown-cur-list-item-bounds))) 8859 (when bounds 8860 ;; Move to beginning of task list item 8861 (goto-char (cl-first bounds)) 8862 ;; Advance to column of first non-whitespace after marker 8863 (forward-char (cl-fourth bounds)) 8864 (cond ((looking-at "\\[ \\]") 8865 (replace-match 8866 (if markdown-gfm-uppercase-checkbox "[X]" "[x]") 8867 nil t) 8868 (match-string-no-properties 0)) 8869 ((looking-at "\\[[xX]\\]") 8870 (replace-match "[ ]" nil t) 8871 (match-string-no-properties 0)))))))) 8872 8873 (defun markdown-toggle-gfm-checkbox-button (button) 8874 "Toggle GFM checkbox BUTTON on click." 8875 (save-match-data 8876 (save-excursion 8877 (goto-char (button-start button)) 8878 (markdown-toggle-gfm-checkbox)))) 8879 8880 (defun markdown-make-gfm-checkboxes-buttons (start end) 8881 "Make GFM checkboxes buttons in region between START and END." 8882 (save-excursion 8883 (goto-char start) 8884 (let ((case-fold-search t)) 8885 (save-excursion 8886 (while (re-search-forward markdown-regex-gfm-checkbox end t) 8887 (make-button (match-beginning 1) (match-end 1) 8888 :type 'markdown-gfm-checkbox-button)))))) 8889 8890 ;; Called when any modification is made to buffer text. 8891 (defun markdown-gfm-checkbox-after-change-function (beg end _) 8892 "Add to `after-change-functions' to setup GFM checkboxes as buttons. 8893 BEG and END are the limits of scanned region." 8894 (save-excursion 8895 (save-match-data 8896 ;; Rescan between start of line from `beg' and start of line after `end'. 8897 (markdown-make-gfm-checkboxes-buttons 8898 (progn (goto-char beg) (beginning-of-line) (point)) 8899 (progn (goto-char end) (forward-line 1) (point)))))) 8900 8901 (defun markdown-remove-gfm-checkbox-overlays () 8902 "Remove all GFM checkbox overlays in buffer." 8903 (save-excursion 8904 (save-restriction 8905 (widen) 8906 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) 8907 8908 8909 ;;; Display inline image ====================================================== 8910 8911 (defvar-local markdown-inline-image-overlays nil) 8912 8913 (defun markdown-remove-inline-images () 8914 "Remove inline image overlays from image links in the buffer. 8915 This can be toggled with `markdown-toggle-inline-images' 8916 or \\[markdown-toggle-inline-images]." 8917 (interactive) 8918 (mapc #'delete-overlay markdown-inline-image-overlays) 8919 (setq markdown-inline-image-overlays nil) 8920 (when (fboundp 'clear-image-cache) (clear-image-cache))) 8921 8922 (defcustom markdown-display-remote-images nil 8923 "If non-nil, download and display remote images. 8924 See also `markdown-inline-image-overlays'. 8925 8926 Only image URLs specified with a protocol listed in 8927 `markdown-remote-image-protocols' are displayed." 8928 :group 'markdown 8929 :type 'boolean) 8930 8931 (defcustom markdown-remote-image-protocols '("https") 8932 "List of protocols to use to download remote images. 8933 See also `markdown-display-remote-images'." 8934 :group 'markdown 8935 :type '(repeat string)) 8936 8937 (defvar markdown--remote-image-cache 8938 (make-hash-table :test 'equal) 8939 "A map from URLs to image paths.") 8940 8941 (defun markdown--get-remote-image (url) 8942 "Retrieve the image path for a given URL." 8943 (or (gethash url markdown--remote-image-cache) 8944 (let ((dl-path (make-temp-file "markdown-mode--image"))) 8945 (require 'url) 8946 (url-copy-file url dl-path t) 8947 (puthash url dl-path markdown--remote-image-cache)))) 8948 8949 (defun markdown-display-inline-images () 8950 "Add inline image overlays to image links in the buffer. 8951 This can be toggled with `markdown-toggle-inline-images' 8952 or \\[markdown-toggle-inline-images]." 8953 (interactive) 8954 (unless (display-images-p) 8955 (error "Cannot show images")) 8956 (save-excursion 8957 (save-restriction 8958 (widen) 8959 (goto-char (point-min)) 8960 (while (re-search-forward markdown-regex-link-inline nil t) 8961 (let* ((start (match-beginning 0)) 8962 (imagep (match-beginning 1)) 8963 (end (match-end 0)) 8964 (file (match-string-no-properties 6))) 8965 (when (and imagep 8966 (not (zerop (length file)))) 8967 (unless (file-exists-p file) 8968 (let* ((download-file (funcall markdown-translate-filename-function file)) 8969 (valid-url (ignore-errors 8970 (member (downcase (url-type (url-generic-parse-url download-file))) 8971 markdown-remote-image-protocols)))) 8972 (if (and markdown-display-remote-images valid-url) 8973 (setq file (markdown--get-remote-image download-file)) 8974 (when (not valid-url) 8975 ;; strip query parameter 8976 (setq file (replace-regexp-in-string "?.+\\'" "" file)) 8977 (unless (file-exists-p file) 8978 (setq file (url-unhex-string file))))))) 8979 (when (file-exists-p file) 8980 (let* ((abspath (if (file-name-absolute-p file) 8981 file 8982 (concat default-directory file))) 8983 (image 8984 (cond ((and markdown-max-image-size 8985 (image-type-available-p 'imagemagick)) 8986 (create-image 8987 abspath 'imagemagick nil 8988 :max-width (car markdown-max-image-size) 8989 :max-height (cdr markdown-max-image-size))) 8990 (markdown-max-image-size 8991 (create-image abspath nil nil 8992 :max-width (car markdown-max-image-size) 8993 :max-height (cdr markdown-max-image-size))) 8994 (t (create-image abspath))))) 8995 (when image 8996 (let ((ov (make-overlay start end))) 8997 (overlay-put ov 'display image) 8998 (overlay-put ov 'face 'default) 8999 (push ov markdown-inline-image-overlays))))))))))) 9000 9001 (defun markdown-toggle-inline-images () 9002 "Toggle inline image overlays in the buffer." 9003 (interactive) 9004 (if markdown-inline-image-overlays 9005 (markdown-remove-inline-images) 9006 (markdown-display-inline-images))) 9007 9008 9009 ;;; GFM Code Block Fontification ============================================== 9010 9011 (defcustom markdown-fontify-code-blocks-natively nil 9012 "When non-nil, fontify code in code blocks using the native major mode. 9013 This only works for fenced code blocks where the language is 9014 specified where we can automatically determine the appropriate 9015 mode to use. The language to mode mapping may be customized by 9016 setting the variable `markdown-code-lang-modes'." 9017 :group 'markdown 9018 :type 'boolean 9019 :safe #'booleanp 9020 :package-version '(markdown-mode . "2.3")) 9021 9022 (defcustom markdown-fontify-code-block-default-mode nil 9023 "Default mode to use to fontify code blocks. 9024 This mode is used when automatic detection fails, such as for GFM 9025 code blocks with no language specified." 9026 :group 'markdown 9027 :type '(choice function (const :tag "None" nil)) 9028 :package-version '(markdown-mode . "2.4")) 9029 9030 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg) 9031 "Toggle the native fontification of code blocks. 9032 With a prefix argument ARG, enable if ARG is positive, 9033 and disable otherwise." 9034 (interactive (list (or current-prefix-arg 'toggle))) 9035 (setq markdown-fontify-code-blocks-natively 9036 (if (eq arg 'toggle) 9037 (not markdown-fontify-code-blocks-natively) 9038 (> (prefix-numeric-value arg) 0))) 9039 (if markdown-fontify-code-blocks-natively 9040 (message "markdown-mode native code block fontification enabled") 9041 (message "markdown-mode native code block fontification disabled")) 9042 (markdown-reload-extensions)) 9043 9044 ;; This is based on `org-src-lang-modes' from org-src.el 9045 (defcustom markdown-code-lang-modes 9046 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) 9047 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) 9048 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) 9049 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) 9050 ("bash" . sh-mode)) 9051 "Alist mapping languages to their major mode. 9052 The key is the language name, the value is the major mode. For 9053 many languages this is simple, but for language where this is not 9054 the case, this variable provides a way to simplify things on the 9055 user side. For example, there is no ocaml-mode in Emacs, but the 9056 mode to use is `tuareg-mode'." 9057 :group 'markdown 9058 :type '(repeat 9059 (cons 9060 (string "Language name") 9061 (symbol "Major mode"))) 9062 :package-version '(markdown-mode . "2.3")) 9063 9064 (defun markdown-get-lang-mode (lang) 9065 "Return major mode that should be used for LANG. 9066 LANG is a string, and the returned major mode is a symbol." 9067 (cl-find-if 9068 #'markdown--lang-mode-predicate 9069 (nconc (list (cdr (assoc lang markdown-code-lang-modes)) 9070 (cdr (assoc (downcase lang) markdown-code-lang-modes))) 9071 (and (fboundp 'treesit-language-available-p) 9072 (list (and (treesit-language-available-p (intern lang)) 9073 (intern (concat lang "-ts-mode"))) 9074 (and (treesit-language-available-p (intern (downcase lang))) 9075 (intern (concat (downcase lang) "-ts-mode"))))) 9076 (list 9077 (intern (concat lang "-mode")) 9078 (intern (concat (downcase lang) "-mode")))))) 9079 9080 (defun markdown--lang-mode-predicate (mode) 9081 (and mode 9082 (fboundp mode) 9083 (or 9084 ;; https://github.com/jrblevin/markdown-mode/issues/787 9085 ;; major-mode-remap-alist was introduced at Emacs 29.1 9086 (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) 9087 for func = (cdr pair) 9088 thereis (and (atom func) (eq mode func))) 9089 ;; https://github.com/jrblevin/markdown-mode/issues/761 9090 (cl-loop for pair in auto-mode-alist 9091 for func = (cdr pair) 9092 thereis (and (atom func) (eq mode func)))))) 9093 9094 (defun markdown-fontify-code-blocks-generic (matcher last) 9095 "Add text properties to next code block from point to LAST. 9096 Use matching function MATCHER." 9097 (when (funcall matcher last) 9098 (save-excursion 9099 (save-match-data 9100 (let* ((start (match-beginning 0)) 9101 (end (match-end 0)) 9102 ;; Find positions outside opening and closing backquotes. 9103 (bol-prev (progn (goto-char start) 9104 (if (bolp) (line-beginning-position 0) (line-beginning-position)))) 9105 (eol-next (progn (goto-char end) 9106 (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) 9107 lang) 9108 (if (and markdown-fontify-code-blocks-natively 9109 (or (setq lang (markdown-code-block-lang)) 9110 markdown-fontify-code-block-default-mode)) 9111 (markdown-fontify-code-block-natively lang start end) 9112 (add-text-properties start end '(face markdown-pre-face))) 9113 ;; Set background for block as well as opening and closing lines. 9114 (font-lock-append-text-property 9115 bol-prev eol-next 'face 'markdown-code-face) 9116 ;; Set invisible property for lines before and after, including newline. 9117 (add-text-properties bol-prev start '(invisible markdown-markup)) 9118 (add-text-properties end eol-next '(invisible markdown-markup))))) 9119 t)) 9120 9121 (defun markdown-fontify-gfm-code-blocks (last) 9122 "Add text properties to next GFM code block from point to LAST." 9123 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) 9124 9125 (defun markdown-fontify-fenced-code-blocks (last) 9126 "Add text properties to next tilde fenced code block from point to LAST." 9127 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) 9128 9129 ;; Based on `org-src-font-lock-fontify-block' from org-src.el. 9130 (defun markdown-fontify-code-block-natively (lang start end) 9131 "Fontify given GFM or fenced code block. 9132 This function is called by Emacs for automatic fontification when 9133 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the 9134 language used in the block. START and END specify the block 9135 position." 9136 (let ((lang-mode (if lang (markdown-get-lang-mode lang) 9137 markdown-fontify-code-block-default-mode))) 9138 (when (fboundp lang-mode) 9139 (let ((string (buffer-substring-no-properties start end)) 9140 (modified (buffer-modified-p)) 9141 (markdown-buffer (current-buffer)) pos next) 9142 (remove-text-properties start end '(face nil)) 9143 (with-current-buffer 9144 (get-buffer-create 9145 (concat " markdown-code-fontification:" (symbol-name lang-mode))) 9146 ;; Make sure that modification hooks are not inhibited in 9147 ;; the org-src-fontification buffer in case we're called 9148 ;; from `jit-lock-function' (Bug#25132). 9149 (let ((inhibit-modification-hooks nil)) 9150 (delete-region (point-min) (point-max)) 9151 (insert string " ")) ;; so there's a final property change 9152 (unless (eq major-mode lang-mode) (funcall lang-mode)) 9153 (font-lock-ensure) 9154 (setq pos (point-min)) 9155 (while (setq next (next-single-property-change pos 'face)) 9156 (let ((val (get-text-property pos 'face))) 9157 (when val 9158 (put-text-property 9159 (+ start (1- pos)) (1- (+ start next)) 'face 9160 val markdown-buffer))) 9161 (setq pos next))) 9162 (add-text-properties 9163 start end 9164 '(font-lock-fontified t fontified t font-lock-multiline t)) 9165 (set-buffer-modified-p modified))))) 9166 9167 (require 'edit-indirect nil t) 9168 (defvar edit-indirect-guess-mode-function) 9169 (defvar edit-indirect-after-commit-functions) 9170 9171 (defun markdown--edit-indirect-after-commit-function (beg end) 9172 "Corrective logic run on code block content from lines BEG to END. 9173 Restores code block indentation from BEG to END, and ensures trailing newlines 9174 at the END of code blocks." 9175 ;; ensure trailing newlines 9176 (goto-char end) 9177 (unless (eq (char-before) ?\n) 9178 (insert "\n")) 9179 ;; restore code block indentation 9180 (goto-char (- beg 1)) 9181 (let ((block-indentation (current-indentation))) 9182 (when (> block-indentation 0) 9183 (indent-rigidly beg end block-indentation))) 9184 (font-lock-ensure)) 9185 9186 (defun markdown-edit-code-block () 9187 "Edit Markdown code block in an indirect buffer." 9188 (interactive) 9189 (save-excursion 9190 (if (fboundp 'edit-indirect-region) 9191 (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) 9192 (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) 9193 (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) 9194 (if (and begin end) 9195 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) 9196 (lang (markdown-code-block-lang)) 9197 (mode (or (and lang (markdown-get-lang-mode lang)) 9198 markdown-edit-code-block-default-mode)) 9199 (edit-indirect-guess-mode-function 9200 (lambda (_parent-buffer _beg _end) 9201 (funcall mode))) 9202 (indirect-buf (edit-indirect-region begin end 'display-buffer))) 9203 ;; reset `sh-shell' when indirect buffer 9204 (when (and (not (member system-type '(ms-dos windows-nt))) 9205 (member mode '(shell-script-mode sh-mode)) 9206 (member lang (append 9207 (mapcar (lambda (e) (symbol-name (car e))) 9208 sh-ancestor-alist) 9209 '("csh" "rc" "sh")))) 9210 (with-current-buffer indirect-buf 9211 (sh-set-shell lang))) 9212 (when (> indentation 0) ;; un-indent in edit-indirect buffer 9213 (with-current-buffer indirect-buf 9214 (indent-rigidly (point-min) (point-max) (- indentation))))) 9215 (user-error "Not inside a GFM or tilde fenced code block"))) 9216 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") 9217 (progn (package-refresh-contents) 9218 (package-install 'edit-indirect) 9219 (markdown-edit-code-block)))))) 9220 9221 9222 ;;; Table Editing ============================================================= 9223 9224 ;; These functions were originally adapted from `org-table.el'. 9225 9226 ;; General helper functions 9227 9228 (defmacro markdown--with-gensyms (symbols &rest body) 9229 (declare (debug (sexp body)) (indent 1)) 9230 `(let ,(mapcar (lambda (s) 9231 `(,s (make-symbol (concat "--" (symbol-name ',s))))) 9232 symbols) 9233 ,@body)) 9234 9235 (defun markdown--split-string (string &optional separators) 9236 "Splits STRING into substrings at SEPARATORS. 9237 SEPARATORS is a regular expression. If nil it defaults to 9238 `split-string-default-separators'. This version returns no empty 9239 strings if there are matches at the beginning and end of string." 9240 (let ((start 0) notfirst list) 9241 (while (and (string-match 9242 (or separators split-string-default-separators) 9243 string 9244 (if (and notfirst 9245 (= start (match-beginning 0)) 9246 (< start (length string))) 9247 (1+ start) start)) 9248 (< (match-beginning 0) (length string))) 9249 (setq notfirst t) 9250 (or (eq (match-beginning 0) 0) 9251 (and (eq (match-beginning 0) (match-end 0)) 9252 (eq (match-beginning 0) start)) 9253 (push (substring string start (match-beginning 0)) list)) 9254 (setq start (match-end 0))) 9255 (or (eq start (length string)) 9256 (push (substring string start) list)) 9257 (nreverse list))) 9258 9259 (defun markdown--string-width (s) 9260 "Return width of string S. 9261 This version ignores characters with invisibility property 9262 `markdown-markup'." 9263 (let (b) 9264 (when (or (eq t buffer-invisibility-spec) 9265 (member 'markdown-markup buffer-invisibility-spec)) 9266 (while (setq b (text-property-any 9267 0 (length s) 9268 'invisible 'markdown-markup s)) 9269 (setq s (concat 9270 (substring s 0 b) 9271 (substring s (or (next-single-property-change 9272 b 'invisible s) 9273 (length s)))))))) 9274 (string-width s)) 9275 9276 (defun markdown--remove-invisible-markup (s) 9277 "Remove Markdown markup from string S. 9278 This version removes characters with invisibility property 9279 `markdown-markup'." 9280 (let (b) 9281 (while (setq b (text-property-any 9282 0 (length s) 9283 'invisible 'markdown-markup s)) 9284 (setq s (concat 9285 (substring s 0 b) 9286 (substring s (or (next-single-property-change 9287 b 'invisible s) 9288 (length s))))))) 9289 s) 9290 9291 ;; Functions for maintaining tables 9292 9293 (defvar markdown-table-at-point-p-function #'markdown--table-at-point-p 9294 "Function to decide if point is inside a table. 9295 9296 The indirection serves to differentiate between standard markdown 9297 tables and gfm tables which are less strict about the markup.") 9298 9299 (defconst markdown-table-line-regexp "^[ \t]*|" 9300 "Regexp matching any line inside a table.") 9301 9302 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]" 9303 "Regexp matching hline inside a table.") 9304 9305 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" 9306 "Regexp matching dline inside a table.") 9307 9308 (defun markdown-table-at-point-p () 9309 "Return non-nil when point is inside a table." 9310 (funcall markdown-table-at-point-p-function)) 9311 9312 (defun markdown--table-at-point-p () 9313 "Return non-nil when point is inside a table." 9314 (save-excursion 9315 (beginning-of-line) 9316 (and (looking-at-p markdown-table-line-regexp) 9317 (not (markdown-code-block-at-point-p))))) 9318 9319 (defconst gfm-table-line-regexp "^.?*|" 9320 "Regexp matching any line inside a table.") 9321 9322 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+" 9323 "Regexp matching hline inside a table.") 9324 9325 ;; GFM simplified tables syntax is as follows: 9326 ;; - A header line for the column names, this is any text 9327 ;; separated by `|'. 9328 ;; - Followed by a string -|-|- ..., the number of dashes is optional 9329 ;; but must be higher than 1. The number of separators should match 9330 ;; the number of columns. 9331 ;; - Followed by the rows of data, which has the same format as the 9332 ;; header line. 9333 ;; Example: 9334 ;; 9335 ;; foo | bar 9336 ;; ------|--------- 9337 ;; bar | baz 9338 ;; bar | baz 9339 (defun gfm--table-at-point-p () 9340 "Return non-nil when point is inside a gfm-compatible table." 9341 (or (markdown--table-at-point-p) 9342 (save-excursion 9343 (beginning-of-line) 9344 (when (looking-at-p gfm-table-line-regexp) 9345 ;; we might be at the first line of the table, check if the 9346 ;; line below is the hline 9347 (or (save-excursion 9348 (forward-line 1) 9349 (looking-at-p gfm-table-hline-regexp)) 9350 ;; go up to find the header 9351 (catch 'done 9352 (while (looking-at-p gfm-table-line-regexp) 9353 (cond 9354 ((looking-at-p gfm-table-hline-regexp) 9355 (throw 'done t)) 9356 ((bobp) 9357 (throw 'done nil))) 9358 (forward-line -1)) 9359 nil)))))) 9360 9361 (defun markdown-table-hline-at-point-p () 9362 "Return non-nil when point is on a hline in a table. 9363 This function assumes point is on a table." 9364 (save-excursion 9365 (beginning-of-line) 9366 (looking-at-p markdown-table-hline-regexp))) 9367 9368 (defun markdown-table-begin () 9369 "Find the beginning of the table and return its position. 9370 This function assumes point is on a table." 9371 (save-excursion 9372 (while (and (not (bobp)) 9373 (markdown-table-at-point-p)) 9374 (forward-line -1)) 9375 (unless (or (eobp) 9376 (markdown-table-at-point-p)) 9377 (forward-line 1)) 9378 (point))) 9379 9380 (defun markdown-table-end () 9381 "Find the end of the table and return its position. 9382 This function assumes point is on a table." 9383 (save-excursion 9384 (while (and (not (eobp)) 9385 (markdown-table-at-point-p)) 9386 (forward-line 1)) 9387 (point))) 9388 9389 (defun markdown-table-get-dline () 9390 "Return index of the table data line at point. 9391 This function assumes point is on a table." 9392 (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) 9393 (save-excursion 9394 (goto-char (markdown-table-begin)) 9395 (while (and (re-search-forward 9396 markdown-table-dline-regexp end t) 9397 (setq cnt (1+ cnt)) 9398 (< (line-end-position) pos)))) 9399 cnt)) 9400 9401 (defun markdown--thing-at-wiki-link (pos) 9402 (when markdown-enable-wiki-links 9403 (save-excursion 9404 (save-match-data 9405 (goto-char pos) 9406 (thing-at-point-looking-at markdown-regex-wiki-link))))) 9407 9408 (defun markdown-table-get-column () 9409 "Return table column at point. 9410 This function assumes point is on a table." 9411 (let ((pos (point)) (cnt 0)) 9412 (save-excursion 9413 (beginning-of-line) 9414 (while (search-forward "|" pos t) 9415 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9416 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9417 (setq cnt (1+ cnt))))) 9418 cnt)) 9419 9420 (defun markdown-table-get-cell (&optional n) 9421 "Return the content of the cell in column N of current row. 9422 N defaults to column at point. This function assumes point is on 9423 a table." 9424 (and n (markdown-table-goto-column n)) 9425 (skip-chars-backward "^|\n") (backward-char 1) 9426 (if (looking-at "|[^|\r\n]*") 9427 (let* ((pos (match-beginning 0)) 9428 (val (buffer-substring (1+ pos) (match-end 0)))) 9429 (goto-char (min (line-end-position) (+ 2 pos))) 9430 ;; Trim whitespaces 9431 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) 9432 val (replace-regexp-in-string "[ \t]+\\'" "" val))) 9433 (forward-char 1) "")) 9434 9435 (defun markdown-table-goto-dline (n) 9436 "Go to the Nth data line in the table at point. 9437 Return t when the line exists, nil otherwise. This function 9438 assumes point is on a table." 9439 (goto-char (markdown-table-begin)) 9440 (let ((end (markdown-table-end)) (cnt 0)) 9441 (while (and (re-search-forward 9442 markdown-table-dline-regexp end t) 9443 (< (setq cnt (1+ cnt)) n))) 9444 (= cnt n))) 9445 9446 (defun markdown-table-goto-column (n &optional on-delim) 9447 "Go to the Nth column in the table line at point. 9448 With optional argument ON-DELIM, stop with point before the left 9449 delimiter of the cell. If there are less than N cells, just go 9450 beyond the last delimiter. This function assumes point is on a 9451 table." 9452 (beginning-of-line 1) 9453 (when (> n 0) 9454 (while (and (> n 0) (search-forward "|" (line-end-position) t)) 9455 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9456 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9457 (cl-decf n))) 9458 (if on-delim 9459 (backward-char 1) 9460 (when (looking-at " ") (forward-char 1))))) 9461 9462 (defmacro markdown-table-save-cell (&rest body) 9463 "Save cell at point, execute BODY and restore cell. 9464 This function assumes point is on a table." 9465 (declare (debug (body))) 9466 (markdown--with-gensyms (line column) 9467 `(let ((,line (copy-marker (line-beginning-position))) 9468 (,column (markdown-table-get-column))) 9469 (unwind-protect 9470 (progn ,@body) 9471 (goto-char ,line) 9472 (markdown-table-goto-column ,column) 9473 (set-marker ,line nil))))) 9474 9475 (defun markdown-table-blank-line (s) 9476 "Convert a table line S into a line with blank cells." 9477 (if (string-match "^[ \t]*|-" s) 9478 (setq s (mapconcat 9479 (lambda (x) (if (member x '(?| ?+)) "|" " ")) 9480 s "")) 9481 (with-temp-buffer 9482 (insert s) 9483 (goto-char (point-min)) 9484 (when (re-search-forward "|" nil t) 9485 (let ((cur (point)) 9486 ret) 9487 (while (re-search-forward "|" nil t) 9488 (when (and (not (eql (char-before (match-beginning 0)) ?\\)) 9489 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9490 (push (make-string (- (match-beginning 0) cur) ? ) ret) 9491 (setq cur (match-end 0)))) 9492 (format "|%s|" (string-join (nreverse ret) "|"))))))) 9493 9494 (defun markdown-table-colfmt (fmtspec) 9495 "Process column alignment specifier FMTSPEC for tables." 9496 (when (stringp fmtspec) 9497 (mapcar (lambda (x) 9498 (cond ((string-match-p "^:.*:$" x) 'c) 9499 ((string-match-p "^:" x) 'l) 9500 ((string-match-p ":$" x) 'r) 9501 (t 'd))) 9502 (markdown--split-string fmtspec "\\s-*|\\s-*")))) 9503 9504 (defun markdown--first-column-p (bar-pos) 9505 (save-excursion 9506 (save-match-data 9507 (goto-char bar-pos) 9508 (looking-back "^\\s-*" (line-beginning-position))))) 9509 9510 (defun markdown--table-line-to-columns (line) 9511 (with-temp-buffer 9512 (insert line) 9513 (goto-char (point-min)) 9514 (let ((cur (point)) 9515 ret) 9516 (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) 9517 (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) 9518 (if (markdown--first-column-p (match-beginning 1)) 9519 (setq cur (match-end 0)) 9520 (cond ((eql (char-before (match-beginning 1)) ?\\) 9521 ;; keep spaces 9522 (goto-char (match-end 1))) 9523 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing 9524 (t 9525 (push (buffer-substring-no-properties cur (match-beginning 0)) ret) 9526 (setq cur (match-end 0))))))) 9527 (when (< cur (length line)) 9528 (push (buffer-substring-no-properties cur (point-max)) ret)) 9529 (nreverse ret)))) 9530 9531 (defsubst markdown--is-delimiter-row (line) 9532 (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) 9533 (cl-loop for c across line 9534 always (member c '(?| ?- ?: ?\t ? ))))) 9535 9536 (defun markdown-table-align () 9537 "Align table at point. 9538 This function assumes point is on a table." 9539 (interactive) 9540 (let ((begin (markdown-table-begin)) 9541 (end (copy-marker (markdown-table-end)))) 9542 (markdown-table-save-cell 9543 (goto-char begin) 9544 (let* (fmtspec 9545 ;; Store table indent 9546 (indent (progn (looking-at "[ \t]*") (match-string 0))) 9547 ;; Split table in lines and save column format specifier 9548 (lines (mapcar (lambda (line) 9549 (if (markdown--is-delimiter-row line) 9550 (progn (setq fmtspec (or fmtspec line)) nil) 9551 line)) 9552 (markdown--split-string (buffer-substring begin end) "\n"))) 9553 ;; Split lines in cells 9554 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) 9555 (remq nil lines))) 9556 ;; Calculate maximum number of cells in a line 9557 (maxcells (if cells 9558 (apply #'max (mapcar #'length cells)) 9559 (user-error "Empty table"))) 9560 ;; Empty cells to fill short lines 9561 (emptycells (make-list maxcells "")) 9562 maxwidths) 9563 ;; Calculate maximum width for each column 9564 (dotimes (i maxcells) 9565 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) 9566 (push (apply #'max 1 (mapcar #'markdown--string-width column)) 9567 maxwidths))) 9568 (setq maxwidths (nreverse maxwidths)) 9569 ;; Process column format specifier 9570 (setq fmtspec (markdown-table-colfmt fmtspec)) 9571 ;; Compute formats needed for output of table lines 9572 (let ((hfmt (concat indent "|")) 9573 (rfmt (concat indent "|")) 9574 hfmt1 rfmt1 fmt) 9575 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) 9576 (setq fmt (pop fmtspec)) 9577 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) 9578 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) 9579 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) 9580 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) 9581 (setq rfmt (concat rfmt (format rfmt1 width))) 9582 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) 9583 ;; Replace modified lines only 9584 (dolist (line lines) 9585 (let ((line (if line 9586 (apply #'format rfmt (append (pop cells) emptycells)) 9587 hfmt)) 9588 (previous (buffer-substring (point) (line-end-position)))) 9589 (if (equal previous line) 9590 (forward-line) 9591 (insert line "\n") 9592 (delete-region (point) (line-beginning-position 2)))))) 9593 (set-marker end nil))))) 9594 9595 (defun markdown-table-insert-row (&optional arg) 9596 "Insert a new row above the row at point into the table. 9597 With optional argument ARG, insert below the current row." 9598 (interactive "P") 9599 (unless (markdown-table-at-point-p) 9600 (user-error "Not at a table")) 9601 (let* ((line (buffer-substring 9602 (line-beginning-position) (line-end-position))) 9603 (new (markdown-table-blank-line line))) 9604 (beginning-of-line (if arg 2 1)) 9605 (unless (bolp) (insert "\n")) 9606 (insert-before-markers new "\n") 9607 (beginning-of-line 0) 9608 (re-search-forward "| ?" (line-end-position) t))) 9609 9610 (defun markdown-table-delete-row () 9611 "Delete row or horizontal line at point from the table." 9612 (interactive) 9613 (unless (markdown-table-at-point-p) 9614 (user-error "Not at a table")) 9615 (let ((col (current-column))) 9616 (kill-region (line-beginning-position) 9617 (min (1+ (line-end-position)) (point-max))) 9618 (unless (markdown-table-at-point-p) (beginning-of-line 0)) 9619 (move-to-column col))) 9620 9621 (defun markdown-table-move-row (&optional up) 9622 "Move table line at point down. 9623 With optional argument UP, move it up." 9624 (interactive "P") 9625 (unless (markdown-table-at-point-p) 9626 (user-error "Not at a table")) 9627 (let* ((col (current-column)) (pos (point)) 9628 (tonew (if up 0 2)) txt) 9629 (beginning-of-line tonew) 9630 (unless (markdown-table-at-point-p) 9631 (goto-char pos) (user-error "Cannot move row further")) 9632 (goto-char pos) (beginning-of-line 1) (setq pos (point)) 9633 (setq txt (buffer-substring (point) (1+ (line-end-position)))) 9634 (delete-region (point) (1+ (line-end-position))) 9635 (beginning-of-line tonew) 9636 (insert txt) (beginning-of-line 0) 9637 (move-to-column col))) 9638 9639 (defun markdown-table-move-row-up () 9640 "Move table row at point up." 9641 (interactive) 9642 (markdown-table-move-row 'up)) 9643 9644 (defun markdown-table-move-row-down () 9645 "Move table row at point down." 9646 (interactive) 9647 (markdown-table-move-row nil)) 9648 9649 (defun markdown-table-insert-column () 9650 "Insert a new table column." 9651 (interactive) 9652 (unless (markdown-table-at-point-p) 9653 (user-error "Not at a table")) 9654 (let* ((col (max 1 (markdown-table-get-column))) 9655 (begin (markdown-table-begin)) 9656 (end (copy-marker (markdown-table-end)))) 9657 (markdown-table-save-cell 9658 (goto-char begin) 9659 (while (< (point) end) 9660 (markdown-table-goto-column col t) 9661 (if (markdown-table-hline-at-point-p) 9662 (insert "|---") 9663 (insert "| ")) 9664 (forward-line))) 9665 (set-marker end nil) 9666 (when markdown-table-align-p 9667 (markdown-table-align)))) 9668 9669 (defun markdown-table-delete-column () 9670 "Delete column at point from table." 9671 (interactive) 9672 (unless (markdown-table-at-point-p) 9673 (user-error "Not at a table")) 9674 (let ((col (markdown-table-get-column)) 9675 (begin (markdown-table-begin)) 9676 (end (copy-marker (markdown-table-end)))) 9677 (markdown-table-save-cell 9678 (goto-char begin) 9679 (while (< (point) end) 9680 (markdown-table-goto-column col t) 9681 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") 9682 (replace-match "|")) 9683 (forward-line))) 9684 (set-marker end nil) 9685 (markdown-table-goto-column (max 1 (1- col))) 9686 (when markdown-table-align-p 9687 (markdown-table-align)))) 9688 9689 (defun markdown-table-move-column (&optional left) 9690 "Move table column at point to the right. 9691 With optional argument LEFT, move it to the left." 9692 (interactive "P") 9693 (unless (markdown-table-at-point-p) 9694 (user-error "Not at a table")) 9695 (let* ((col (markdown-table-get-column)) 9696 (col1 (if left (1- col) col)) 9697 (colpos (if left (1- col) (1+ col))) 9698 (begin (markdown-table-begin)) 9699 (end (copy-marker (markdown-table-end)))) 9700 (when (and left (= col 1)) 9701 (user-error "Cannot move column further left")) 9702 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) 9703 (user-error "Cannot move column further right")) 9704 (markdown-table-save-cell 9705 (goto-char begin) 9706 (while (< (point) end) 9707 (markdown-table-goto-column col1 t) 9708 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") 9709 (replace-match "|\\2|\\1|")) 9710 (forward-line))) 9711 (set-marker end nil) 9712 (markdown-table-goto-column colpos) 9713 (when markdown-table-align-p 9714 (markdown-table-align)))) 9715 9716 (defun markdown-table-move-column-left () 9717 "Move table column at point to the left." 9718 (interactive) 9719 (markdown-table-move-column 'left)) 9720 9721 (defun markdown-table-move-column-right () 9722 "Move table column at point to the right." 9723 (interactive) 9724 (markdown-table-move-column nil)) 9725 9726 (defun markdown-table-next-row () 9727 "Go to the next row (same column) in the table. 9728 Create new table lines if required." 9729 (interactive) 9730 (unless (markdown-table-at-point-p) 9731 (user-error "Not at a table")) 9732 (if (or (looking-at "[ \t]*$") 9733 (save-excursion (skip-chars-backward " \t") (bolp))) 9734 (newline) 9735 (when markdown-table-align-p 9736 (markdown-table-align)) 9737 (let ((col (markdown-table-get-column))) 9738 (beginning-of-line 2) 9739 (if (or (not (markdown-table-at-point-p)) 9740 (markdown-table-hline-at-point-p)) 9741 (progn 9742 (beginning-of-line 0) 9743 (markdown-table-insert-row 'below))) 9744 (markdown-table-goto-column col) 9745 (skip-chars-backward "^|\n\r") 9746 (when (looking-at " ") (forward-char 1))))) 9747 9748 (defun markdown-table-forward-cell () 9749 "Go to the next cell in the table. 9750 Create new table lines if required." 9751 (interactive) 9752 (unless (markdown-table-at-point-p) 9753 (user-error "Not at a table")) 9754 (when markdown-table-align-p 9755 (markdown-table-align)) 9756 (let ((end (markdown-table-end))) 9757 (when (markdown-table-hline-at-point-p) (end-of-line 1)) 9758 (condition-case nil 9759 (progn 9760 (re-search-forward "\\(?:^\\|[^\\]\\)|" end) 9761 (when (looking-at "[ \t]*$") 9762 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) 9763 (when (and (looking-at "[-:]") 9764 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) 9765 (goto-char (match-beginning 1))) 9766 (if (looking-at "[-:]") 9767 (progn 9768 (beginning-of-line 0) 9769 (markdown-table-insert-row 'below)) 9770 (when (looking-at " ") (forward-char 1)))) 9771 (error (markdown-table-insert-row 'below))))) 9772 9773 (defun markdown-table-backward-cell () 9774 "Go to the previous cell in the table." 9775 (interactive) 9776 (unless (markdown-table-at-point-p) 9777 (user-error "Not at a table")) 9778 (when markdown-table-align-p 9779 (markdown-table-align)) 9780 (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) 9781 (condition-case nil 9782 (progn 9783 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) 9784 ;; When this function is called while in the first cell in a 9785 ;; table, the point will now be at the beginning of a line. In 9786 ;; this case, we need to move past one additional table 9787 ;; boundary, the end of the table on the previous line. 9788 (when (= (point) (line-beginning-position)) 9789 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9790 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9791 (error (user-error "Cannot move to previous table cell"))) 9792 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) 9793 9794 ;; This may have dropped point on the hline. 9795 (when (markdown-table-hline-at-point-p) 9796 (markdown-table-backward-cell))) 9797 9798 (defun markdown-table-transpose () 9799 "Transpose table at point. 9800 Horizontal separator lines will be eliminated." 9801 (interactive) 9802 (unless (markdown-table-at-point-p) 9803 (user-error "Not at a table")) 9804 (let* ((table (buffer-substring-no-properties 9805 (markdown-table-begin) (markdown-table-end))) 9806 ;; Convert table to Lisp structure 9807 (table (delq nil 9808 (mapcar 9809 (lambda (x) 9810 (unless (string-match-p 9811 markdown-table-hline-regexp x) 9812 (markdown--table-line-to-columns x))) 9813 (markdown--split-string table "[ \t]*\n[ \t]*")))) 9814 (dline_old (markdown-table-get-dline)) 9815 (col_old (markdown-table-get-column)) 9816 (contents (mapcar (lambda (_) 9817 (let ((tp table)) 9818 (mapcar 9819 (lambda (_) 9820 (prog1 9821 (pop (car tp)) 9822 (setq tp (cdr tp)))) 9823 table))) 9824 (car table)))) 9825 (goto-char (markdown-table-begin)) 9826 (save-excursion 9827 (re-search-forward "|") (backward-char) 9828 (delete-region (point) (markdown-table-end)) 9829 (insert (mapconcat 9830 (lambda(x) 9831 (concat "| " (mapconcat 'identity x " | " ) " |\n")) 9832 contents ""))) 9833 (markdown-table-goto-dline col_old) 9834 (markdown-table-goto-column dline_old)) 9835 (when markdown-table-align-p 9836 (markdown-table-align))) 9837 9838 (defun markdown-table-sort-lines (&optional sorting-type) 9839 "Sort table lines according to the column at point. 9840 9841 The position of point indicates the column to be used for 9842 sorting, and the range of lines is the range between the nearest 9843 horizontal separator lines, or the entire table of no such lines 9844 exist. If point is before the first column, user will be prompted 9845 for the sorting column. If there is an active region, the mark 9846 specifies the first line and the sorting column, while point 9847 should be in the last line to be included into the sorting. 9848 9849 The command then prompts for the sorting type which can be 9850 alphabetically or numerically. Sorting in reverse order is also 9851 possible. 9852 9853 If SORTING-TYPE is specified when this function is called from a 9854 Lisp program, no prompting will take place. SORTING-TYPE must be 9855 a character, any of (?a ?A ?n ?N) where the capital letters 9856 indicate that sorting should be done in reverse order." 9857 (interactive) 9858 (unless (markdown-table-at-point-p) 9859 (user-error "Not at a table")) 9860 ;; Set sorting type and column used for sorting 9861 (let ((column (let ((c (markdown-table-get-column))) 9862 (cond ((> c 0) c) 9863 ((called-interactively-p 'any) 9864 (read-number "Use column N for sorting: ")) 9865 (t 1)))) 9866 (sorting-type 9867 (or sorting-type 9868 (progn 9869 ;; workaround #641 9870 ;; Emacs < 28 hides prompt message by another message. This erases it. 9871 (message "") 9872 (read-char-exclusive 9873 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) 9874 (save-restriction 9875 ;; Narrow buffer to appropriate sorting area 9876 (if (region-active-p) 9877 (narrow-to-region 9878 (save-excursion 9879 (progn 9880 (goto-char (region-beginning)) (line-beginning-position))) 9881 (save-excursion 9882 (progn 9883 (goto-char (region-end)) (line-end-position)))) 9884 (let ((start (markdown-table-begin)) 9885 (end (markdown-table-end))) 9886 (narrow-to-region 9887 (save-excursion 9888 (if (re-search-backward 9889 markdown-table-hline-regexp start t) 9890 (line-beginning-position 2) 9891 start)) 9892 (if (save-excursion (re-search-forward 9893 markdown-table-hline-regexp end t)) 9894 (match-beginning 0) 9895 end)))) 9896 ;; Determine arguments for `sort-subr' 9897 (let* ((extract-key-from-cell 9898 (cl-case sorting-type 9899 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) 9900 ((?n ?N) #'string-to-number) 9901 (t (user-error "Invalid sorting type: %c" sorting-type)))) 9902 (predicate 9903 (cl-case sorting-type 9904 ((?n ?N) #'<) 9905 ((?a ?A) #'string<)))) 9906 ;; Sort selected area 9907 (goto-char (point-min)) 9908 (sort-subr (memq sorting-type '(?A ?N)) 9909 (lambda () 9910 (forward-line) 9911 (while (and (not (eobp)) 9912 (not (looking-at 9913 markdown-table-dline-regexp))) 9914 (forward-line))) 9915 #'end-of-line 9916 (lambda () 9917 (funcall extract-key-from-cell 9918 (markdown-table-get-cell column))) 9919 nil 9920 predicate) 9921 (goto-char (point-min)))))) 9922 9923 (defun markdown-table-convert-region (begin end &optional separator) 9924 "Convert region from BEGIN to END to table with SEPARATOR. 9925 9926 If every line contains at least one TAB character, the function 9927 assumes that the material is tab separated (TSV). If every line 9928 contains a comma, comma-separated values (CSV) are assumed. If 9929 not, lines are split at whitespace into cells. 9930 9931 You can use a prefix argument to force a specific separator: 9932 \\[universal-argument] once forces CSV, \\[universal-argument] 9933 twice forces TAB, and \\[universal-argument] three times will 9934 prompt for a regular expression to match the separator, and a 9935 numeric argument N indicates that at least N consecutive 9936 spaces, or alternatively a TAB should be used as the separator." 9937 9938 (interactive "r\nP") 9939 (let* ((begin (min begin end)) (end (max begin end)) re) 9940 (goto-char begin) (beginning-of-line 1) 9941 (setq begin (point-marker)) 9942 (goto-char end) 9943 (if (bolp) (backward-char 1) (end-of-line 1)) 9944 (setq end (point-marker)) 9945 (when (equal separator '(64)) 9946 (setq separator (read-regexp "Regexp for cell separator: "))) 9947 (unless separator 9948 ;; Get the right cell separator 9949 (goto-char begin) 9950 (setq separator 9951 (cond 9952 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) 9953 ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) 9954 (t 1)))) 9955 (goto-char begin) 9956 (if (equal separator '(4)) 9957 ;; Parse CSV 9958 (while (< (point) end) 9959 (cond 9960 ((looking-at "^") (insert "| ")) 9961 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) 9962 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") 9963 (replace-match "\\1") (if (looking-at "\"") (insert "\""))) 9964 ((looking-at "[^,\n]+") (goto-char (match-end 0))) 9965 ((looking-at "[ \t]*,") (replace-match " | ")) 9966 (t (beginning-of-line 2)))) 9967 (setq re 9968 (cond 9969 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") 9970 ((equal separator '(16)) "^\\|\t") 9971 ((integerp separator) 9972 (if (< separator 1) 9973 (user-error "Cell separator must contain one or more spaces") 9974 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) 9975 ((stringp separator) (format "^ *\\|%s" separator)) 9976 (t (error "Invalid cell separator")))) 9977 (let (finish) 9978 (while (and (not finish) (re-search-forward re end t)) 9979 (if (eolp) 9980 (progn 9981 (replace-match "|" t t) 9982 (forward-line 1) 9983 (when (eobp) 9984 (setq finish t))) 9985 (replace-match "| " t t))))) 9986 (goto-char begin) 9987 (when markdown-table-align-p 9988 (markdown-table-align)))) 9989 9990 (defun markdown-insert-table (&optional rows columns align) 9991 "Insert an empty pipe table. 9992 Optional arguments ROWS, COLUMNS, and ALIGN specify number of 9993 rows and columns and the column alignment." 9994 (interactive) 9995 (let* ((rows (or rows (read-number "Number of Rows: "))) 9996 (columns (or columns (read-number "Number of Columns: "))) 9997 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) 9998 (align (cond ((equal align "l") ":--") 9999 ((equal align "r") "--:") 10000 ((equal align "c") ":-:") 10001 (t "---"))) 10002 (pos (point)) 10003 (indent (make-string (current-column) ?\ )) 10004 (line (concat 10005 (apply 'concat indent "|" 10006 (make-list columns " |")) "\n")) 10007 (hline (apply 'concat indent "|" 10008 (make-list columns (concat align "|"))))) 10009 (if (string-match 10010 "^[ \t]*$" (buffer-substring-no-properties 10011 (line-beginning-position) (point))) 10012 (beginning-of-line 1) 10013 (newline)) 10014 (dotimes (_ rows) (insert line)) 10015 (goto-char pos) 10016 (if (> rows 1) 10017 (progn 10018 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) 10019 (markdown-table-forward-cell))) 10020 10021 10022 ;;; ElDoc Support ============================================================= 10023 10024 (defun markdown-eldoc-function (&rest _ignored) 10025 "Return a helpful string when appropriate based on context. 10026 * Report URL when point is at a hidden URL. 10027 * Report language name when point is a code block with hidden markup." 10028 (cond 10029 ;; Hidden URL or reference for inline link 10030 ((and (or (thing-at-point-looking-at markdown-regex-link-inline) 10031 (thing-at-point-looking-at markdown-regex-link-reference)) 10032 (or markdown-hide-urls markdown-hide-markup)) 10033 (let* ((imagep (string-equal (match-string 1) "!")) 10034 (referencep (string-equal (match-string 5) "[")) 10035 (link (match-string-no-properties 6)) 10036 (edit-keys (markdown--substitute-command-keys 10037 (if imagep 10038 "\\[markdown-insert-image]" 10039 "\\[markdown-insert-link]"))) 10040 (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) 10041 (object (if referencep "reference" "URL"))) 10042 (format "Hidden %s (%s to edit): %s" object edit-str 10043 (if referencep 10044 (concat 10045 (propertize "[" 'face 'markdown-markup-face) 10046 (propertize link 'face 'markdown-reference-face) 10047 (propertize "]" 'face 'markdown-markup-face)) 10048 (propertize link 'face 'markdown-url-face))))) 10049 ;; Hidden language name for fenced code blocks 10050 ((and (markdown-code-block-at-point-p) 10051 (not (get-text-property (point) 'markdown-pre)) 10052 markdown-hide-markup) 10053 (let ((lang (save-excursion (markdown-code-block-lang)))) 10054 (unless lang (setq lang "[unspecified]")) 10055 (format "Hidden code block language: %s (%s to toggle markup)" 10056 (propertize lang 'face 'markdown-language-keyword-face) 10057 (markdown--substitute-command-keys 10058 "\\[markdown-toggle-markup-hiding]")))))) 10059 10060 (defun markdown--image-media-handler (mimetype data) 10061 (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) 10062 (filename (read-string "Insert filename for image: ")) 10063 (link-text (read-string "Link text: ")) 10064 (filepath (file-name-with-extension filename ext)) 10065 (dir (file-name-directory filepath))) 10066 (when (and dir (not (file-directory-p dir))) 10067 (make-directory dir t)) 10068 (with-temp-file filepath 10069 (insert data)) 10070 (when (string-match-p "\\s-" filepath) 10071 (setq filepath (concat "<" filepath ">"))) 10072 (markdown-insert-inline-image link-text filepath))) 10073 10074 (defun markdown--file-media-handler (_mimetype data) 10075 (let* ((data (split-string data "[\0\r\n]" t "^file://")) 10076 (files (cdr data))) 10077 (while (not (null files)) 10078 (let* ((file (url-unhex-string (car files))) 10079 (file (file-relative-name file)) 10080 (prompt (format "Link text(%s): " (file-name-nondirectory file))) 10081 (link-text (read-string prompt))) 10082 (when (string-match-p "\\s-" file) 10083 (setq file (concat "<" file ">"))) 10084 (markdown-insert-inline-image link-text file) 10085 (when (not (null (cdr files))) 10086 (insert " ")) 10087 (setq files (cdr files)))))) 10088 10089 (defun markdown--dnd-local-file-handler (url _action) 10090 (require 'mailcap) 10091 (require 'dnd) 10092 (let* ((filename (dnd-get-local-file-name url)) 10093 (mimetype (mailcap-file-name-to-mime-type filename)) 10094 (file (file-relative-name filename)) 10095 (link-text "link text")) 10096 (when (string-match-p "\\s-" file) 10097 (setq file (concat "<" file ">"))) 10098 (if (string-prefix-p "image/" mimetype) 10099 (markdown-insert-inline-image link-text file) 10100 (markdown-insert-inline-link link-text file)))) 10101 10102 10103 ;;; Mode Definition ========================================================== 10104 10105 (defun markdown-show-version () 10106 "Show the version number in the minibuffer." 10107 (interactive) 10108 (message "markdown-mode, version %s" markdown-mode-version)) 10109 10110 (defun markdown-mode-info () 10111 "Open the `markdown-mode' homepage." 10112 (interactive) 10113 (browse-url "https://jblevins.org/projects/markdown-mode/")) 10114 10115 ;;;###autoload 10116 (define-derived-mode markdown-mode text-mode "Markdown" 10117 "Major mode for editing Markdown files." 10118 (when buffer-read-only 10119 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) 10120 (setq-local buffer-read-only nil))) 10121 ;; Natural Markdown tab width 10122 (setq tab-width 4) 10123 ;; Comments 10124 (setq-local comment-start "<!-- ") 10125 (setq-local comment-end " -->") 10126 (setq-local comment-start-skip "<!--[ \t]*") 10127 (setq-local comment-column 0) 10128 (setq-local comment-auto-fill-only-comments nil) 10129 (setq-local comment-use-syntax t) 10130 ;; Sentence 10131 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") 10132 ;; Syntax 10133 (add-hook 'syntax-propertize-extend-region-functions 10134 #'markdown-syntax-propertize-extend-region nil t) 10135 (add-hook 'jit-lock-after-change-extend-region-functions 10136 #'markdown-font-lock-extend-region-function t t) 10137 (setq-local syntax-propertize-function #'markdown-syntax-propertize) 10138 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. 10139 ;; Font lock. 10140 (setq font-lock-defaults 10141 '(markdown-mode-font-lock-keywords 10142 nil nil nil nil 10143 (font-lock-multiline . t) 10144 (font-lock-syntactic-face-function . markdown-syntactic-face) 10145 (font-lock-extra-managed-props 10146 . (composition display invisible rear-nonsticky 10147 keymap help-echo mouse-face)))) 10148 (if markdown-hide-markup 10149 (add-to-invisibility-spec 'markdown-markup) 10150 (remove-from-invisibility-spec 'markdown-markup)) 10151 ;; Wiki links 10152 (markdown-setup-wiki-link-hooks) 10153 ;; Math mode 10154 (when markdown-enable-math (markdown-toggle-math t)) 10155 ;; Add a buffer-local hook to reload after file-local variables are read 10156 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) 10157 ;; For imenu support 10158 (setq imenu-create-index-function 10159 (if markdown-nested-imenu-heading-index 10160 #'markdown-imenu-create-nested-index 10161 #'markdown-imenu-create-flat-index)) 10162 10163 ;; Defun movement 10164 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) 10165 (setq-local end-of-defun-function #'markdown-end-of-defun) 10166 ;; Paragraph filling 10167 (setq-local fill-paragraph-function #'markdown-fill-paragraph) 10168 (setq-local paragraph-start 10169 ;; Should match start of lines that start or separate paragraphs 10170 (mapconcat #'identity 10171 '( 10172 "\f" ; starts with a literal line-feed 10173 "[ \t\f]*$" ; space-only line 10174 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10175 "[ \t]*[*+-][ \t]+" ; unordered list item 10176 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item 10177 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def 10178 "[ \t]*:[ \t]+" ; definition 10179 "^|" ; table or Pandoc line block 10180 ) 10181 "\\|")) 10182 (setq-local paragraph-separate 10183 ;; Should match lines that separate paragraphs without being 10184 ;; part of any paragraph: 10185 (mapconcat #'identity 10186 '("[ \t\f]*$" ; space-only line 10187 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10188 ;; The following is not ideal, but the Fill customization 10189 ;; options really only handle paragraph-starting prefixes, 10190 ;; not paragraph-ending suffixes: 10191 ".* $" ; line ending in two spaces 10192 "^#+" 10193 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext 10194 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def 10195 "\\|")) 10196 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") 10197 (setq-local adaptive-fill-regexp "\\s-*") 10198 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) 10199 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) 10200 ;; Outline mode 10201 (setq-local outline-regexp markdown-regex-header) 10202 (setq-local outline-level #'markdown-outline-level) 10203 ;; Cause use of ellipses for invisible text. 10204 (add-to-invisibility-spec '(outline . t)) 10205 ;; ElDoc support 10206 (if (boundp 'eldoc-documentation-functions) 10207 (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) 10208 (add-function :before-until (local 'eldoc-documentation-function) 10209 #'markdown-eldoc-function)) 10210 ;; Inhibiting line-breaking: 10211 ;; Separating out each condition into a separate function so that users can 10212 ;; override if desired (with remove-hook) 10213 (add-hook 'fill-nobreak-predicate 10214 #'markdown-line-is-reference-definition-p nil t) 10215 (add-hook 'fill-nobreak-predicate 10216 #'markdown-pipe-at-bol-p nil t) 10217 10218 ;; Indentation 10219 (setq-local indent-line-function markdown-indent-function) 10220 (setq-local indent-region-function #'markdown--indent-region) 10221 10222 ;; Flyspell 10223 (setq-local flyspell-generic-check-word-predicate 10224 #'markdown-flyspell-check-word-p) 10225 10226 ;; Electric quoting 10227 (add-hook 'electric-quote-inhibit-functions 10228 #'markdown--inhibit-electric-quote nil :local) 10229 10230 ;; drag and drop handler 10231 (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) 10232 dnd-protocol-alist)) 10233 10234 ;; media handler 10235 (when (version< "29" emacs-version) 10236 (yank-media-handler "image/.*" #'markdown--image-media-handler) 10237 ;; TODO support other than GNOME, like KDE etc 10238 (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) 10239 10240 ;; Make checkboxes buttons 10241 (when markdown-make-gfm-checkboxes-buttons 10242 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) 10243 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) 10244 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) 10245 10246 ;; edit-indirect 10247 (add-hook 'edit-indirect-after-commit-functions 10248 #'markdown--edit-indirect-after-commit-function 10249 nil 'local) 10250 10251 ;; Marginalized headings 10252 (when markdown-marginalize-headers 10253 (add-hook 'window-configuration-change-hook 10254 #'markdown-marginalize-update-current nil t)) 10255 10256 ;; add live preview export hook 10257 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) 10258 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) 10259 10260 ;; Add a custom keymap for `visual-line-mode' so that activating 10261 ;; this minor mode does not override markdown-mode's keybindings. 10262 ;; FIXME: Probably `visual-line-mode' should take care of this. 10263 (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) 10264 (newmap (make-sparse-keymap))) 10265 (set-keymap-parent newmap oldmap) 10266 (define-key newmap [remap move-beginning-of-line] nil) 10267 (define-key newmap [remap move-end-of-line] nil) 10268 (make-local-variable 'minor-mode-overriding-map-alist) 10269 (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) 10270 10271 ;;;###autoload 10272 (add-to-list 'auto-mode-alist 10273 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) 10274 10275 10276 ;;; GitHub Flavored Markdown Mode ============================================ 10277 10278 (defun gfm--electric-pair-fence-code-block () 10279 (when (and electric-pair-mode 10280 (not markdown-gfm-use-electric-backquote) 10281 (eql last-command-event ?`) 10282 (let ((count 0)) 10283 (while (eql (char-before (- (point) count)) ?`) 10284 (cl-incf count)) 10285 (= count 3)) 10286 (eql (char-after) ?`)) 10287 (save-excursion (insert (make-string 2 ?`))))) 10288 10289 (defvar gfm-mode-hook nil 10290 "Hook run when entering GFM mode.") 10291 10292 ;;;###autoload 10293 (define-derived-mode gfm-mode markdown-mode "GFM" 10294 "Major mode for editing GitHub Flavored Markdown files." 10295 (setq markdown-link-space-sub-char "-") 10296 (setq markdown-wiki-link-search-subdirectories t) 10297 (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) 10298 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) 10299 (markdown-gfm-parse-buffer-for-languages)) 10300 10301 10302 ;;; Viewing modes ============================================================= 10303 10304 (defcustom markdown-hide-markup-in-view-modes t 10305 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." 10306 :group 'markdown 10307 :type 'boolean 10308 :safe #'booleanp) 10309 10310 (defvar markdown-view-mode-map 10311 (let ((map (make-sparse-keymap))) 10312 (define-key map (kbd "p") #'markdown-outline-previous) 10313 (define-key map (kbd "n") #'markdown-outline-next) 10314 (define-key map (kbd "f") #'markdown-outline-next-same-level) 10315 (define-key map (kbd "b") #'markdown-outline-previous-same-level) 10316 (define-key map (kbd "u") #'markdown-outline-up) 10317 (define-key map (kbd "DEL") #'scroll-down-command) 10318 (define-key map (kbd "SPC") #'scroll-up-command) 10319 (define-key map (kbd ">") #'end-of-buffer) 10320 (define-key map (kbd "<") #'beginning-of-buffer) 10321 (define-key map (kbd "q") #'kill-this-buffer) 10322 (define-key map (kbd "?") #'describe-mode) 10323 map) 10324 "Keymap for `markdown-view-mode'.") 10325 10326 (defun markdown--filter-visible (beg end &optional delete) 10327 (let ((result "") 10328 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) 10329 (while (< beg end) 10330 (when (markdown--face-p beg invisible-faces) 10331 (cl-incf beg) 10332 (while (and (markdown--face-p beg invisible-faces) (< beg end)) 10333 (cl-incf beg))) 10334 (let ((next (next-single-char-property-change beg 'invisible))) 10335 (unless (get-char-property beg 'invisible) 10336 (setq result (concat result (buffer-substring beg (min end next))))) 10337 (setq beg next))) 10338 (prog1 result 10339 (when delete 10340 (let ((inhibit-read-only t)) 10341 (delete-region beg end)))))) 10342 10343 ;;;###autoload 10344 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View" 10345 "Major mode for viewing Markdown content." 10346 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10347 (add-to-invisibility-spec 'markdown-markup) 10348 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10349 (read-only-mode 1)) 10350 10351 (defvar gfm-view-mode-map 10352 markdown-view-mode-map 10353 "Keymap for `gfm-view-mode'.") 10354 10355 ;;;###autoload 10356 (define-derived-mode gfm-view-mode gfm-mode "GFM-View" 10357 "Major mode for viewing GitHub Flavored Markdown content." 10358 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10359 (setq-local markdown-fontify-code-blocks-natively t) 10360 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10361 (add-to-invisibility-spec 'markdown-markup) 10362 (read-only-mode 1)) 10363 10364 10365 ;;; Live Preview Mode ======================================================== 10366 ;;;###autoload 10367 (define-minor-mode markdown-live-preview-mode 10368 "Toggle native previewing on save for a specific markdown file." 10369 :lighter " MD-Preview" 10370 (if markdown-live-preview-mode 10371 (if (markdown-live-preview-get-filename) 10372 (markdown-display-buffer-other-window (markdown-live-preview-export)) 10373 (markdown-live-preview-mode -1) 10374 (user-error "Buffer %s does not visit a file" (current-buffer))) 10375 (markdown-live-preview-remove))) 10376 10377 10378 (provide 'markdown-mode) 10379 10380 ;; Local Variables: 10381 ;; indent-tabs-mode: nil 10382 ;; coding: utf-8 10383 ;; End: 10384 ;;; markdown-mode.el ends here