markdown-mode.el (439962B)
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 (defmacro markdown-rx (&rest regexps) 705 "Markdown mode specialized rx macro. 706 This variant of `rx' supports common Markdown named REGEXPS." 707 `(rx-let ((newline "\n") 708 ;; Note: #405 not consider markdown-list-indent-width however this is never used 709 (indent (or (repeat 4 " ") "\t")) 710 (block-end (and (or (one-or-more (zero-or-more blank) "\n") line-end))) 711 (numeral (and (one-or-more (any "0-9#")) ".")) 712 (bullet (any "*+:-")) 713 (list-marker (or (and (one-or-more (any "0-9#")) ".") 714 (any "*+:-"))) 715 (checkbox (seq "[" (any " xX") "]"))) 716 (rx ,@regexps))) 717 718 719 ;;; Regular Expressions ======================================================= 720 721 (defconst markdown-regex-comment-start 722 "<!--" 723 "Regular expression matches HTML comment opening.") 724 725 (defconst markdown-regex-comment-end 726 "--[ \t]*>" 727 "Regular expression matches HTML comment closing.") 728 729 (defconst markdown-regex-link-inline 730 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" 731 "Regular expression for a [text](file) or an image link ![text](file). 732 Group 1 matches the leading exclamation point (optional). 733 Group 2 matches the opening square bracket. 734 Group 3 matches the text inside the square brackets. 735 Group 4 matches the closing square bracket. 736 Group 5 matches the opening parenthesis. 737 Group 6 matches the URL. 738 Group 7 matches the title (optional). 739 Group 8 matches the closing parenthesis.") 740 741 (defconst markdown-regex-link-reference 742 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" 743 "Regular expression for a reference link [text][id]. 744 Group 1 matches the leading exclamation point (optional). 745 Group 2 matches the opening square bracket for the link text. 746 Group 3 matches the text inside the square brackets. 747 Group 4 matches the closing square bracket for the link text. 748 Group 5 matches the opening square bracket for the reference label. 749 Group 6 matches the reference label. 750 Group 7 matches the closing square bracket for the reference label.") 751 752 (defconst markdown-regex-reference-definition 753 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" 754 "Regular expression for a reference definition. 755 Group 1 matches the opening square bracket. 756 Group 2 matches the reference label. 757 Group 3 matches the closing square bracket. 758 Group 4 matches the colon. 759 Group 5 matches the URL. 760 Group 6 matches the title attribute (optional).") 761 762 (defconst markdown-regex-footnote 763 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" 764 "Regular expression for a footnote marker [^fn]. 765 Group 1 matches the opening square bracket and carat. 766 Group 2 matches only the label, without the surrounding markup. 767 Group 3 matches the closing square bracket.") 768 769 (defconst markdown-regex-header 770 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" 771 "Regexp identifying Markdown headings. 772 Group 1 matches the text of a setext heading. 773 Group 2 matches the underline of a level-1 setext heading. 774 Group 3 matches the underline of a level-2 setext heading. 775 Group 4 matches the opening hash marks of an atx heading and whitespace. 776 Group 5 matches the text, without surrounding whitespace, of an atx heading. 777 Group 6 matches the closing whitespace and hash marks of an atx heading.") 778 779 (defconst markdown-regex-header-setext 780 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" 781 "Regular expression for generic setext-style (underline) headers.") 782 783 (defconst markdown-regex-header-atx 784 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" 785 "Regular expression for generic atx-style (hash mark) headers.") 786 787 (defconst markdown-regex-hr 788 (rx line-start 789 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) 790 (and (repeat 3 (and "-" (? " "))) (* (any "- "))) 791 (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) 792 line-end) 793 "Regular expression for matching Markdown horizontal rules.") 794 795 (defconst markdown-regex-code 796 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" 797 "Regular expression for matching inline code fragments. 798 799 Group 1 matches the entire code fragment including the backquotes. 800 Group 2 matches the opening backquotes. 801 Group 3 matches the code fragment itself, without backquotes. 802 Group 4 matches the closing backquotes. 803 804 The leading, unnumbered group ensures that the leading backquote 805 character is not escaped. 806 The last group, also unnumbered, requires that the character 807 following the code fragment is not a backquote. 808 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, 809 but not two newlines in a row.") 810 811 (defconst markdown-regex-kbd 812 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" 813 "Regular expression for matching <kbd> tags. 814 Groups 1 and 3 match the opening and closing tags. 815 Group 2 matches the key sequence.") 816 817 (defconst markdown-regex-gfm-code-block-open 818 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" 819 "Regular expression matching opening of GFM code blocks. 820 Group 1 matches the opening three backquotes and any following whitespace. 821 Group 2 matches the opening brace (optional) and surrounding whitespace. 822 Group 3 matches the language identifier (optional). 823 Group 4 matches the info string (optional). 824 Group 5 matches the closing brace (optional), whitespace, and newline. 825 Groups need to agree with `markdown-regex-tilde-fence-begin'.") 826 827 (defconst markdown-regex-gfm-code-block-close 828 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" 829 "Regular expression matching closing of GFM code blocks. 830 Group 1 matches the closing three backquotes. 831 Group 2 matches any whitespace and the final newline.") 832 833 (defconst markdown-regex-pre 834 "^\\( \\|\t\\).*$" 835 "Regular expression for matching preformatted text sections.") 836 837 (defconst markdown-regex-list 838 (markdown-rx line-start 839 ;; 1. Leading whitespace 840 (group (* blank)) 841 ;; 2. List marker: a numeral, bullet, or colon 842 (group list-marker) 843 ;; 3. Trailing whitespace 844 (group (+ blank)) 845 ;; 4. Optional checkbox for GFM task list items 846 (opt (group (and checkbox (* blank))))) 847 "Regular expression for matching list items.") 848 849 (defconst markdown-regex-bold 850 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" 851 "Regular expression for matching bold text. 852 Group 1 matches the character before the opening asterisk or 853 underscore, if any, ensuring that it is not a backslash escape. 854 Group 2 matches the entire expression, including delimiters. 855 Groups 3 and 5 matches the opening and closing delimiters. 856 Group 4 matches the text inside the delimiters.") 857 858 (defconst markdown-regex-italic 859 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" 860 "Regular expression for matching italic text. 861 The leading unnumbered matches the character before the opening 862 asterisk or underscore, if any, ensuring that it is not a 863 backslash escape. 864 Group 1 matches the entire expression, including delimiters. 865 Groups 2 and 4 matches the opening and closing delimiters. 866 Group 3 matches the text inside the delimiters.") 867 868 (defconst markdown-regex-strike-through 869 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" 870 "Regular expression for matching strike-through text. 871 Group 1 matches the character before the opening tilde, if any, 872 ensuring that it is not a backslash escape. 873 Group 2 matches the entire expression, including delimiters. 874 Groups 3 and 5 matches the opening and closing delimiters. 875 Group 4 matches the text inside the delimiters.") 876 877 (defconst markdown-regex-gfm-italic 878 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" 879 "Regular expression for matching italic text in GitHub Flavored Markdown. 880 Underscores in words are not treated as special. 881 Group 1 matches the entire expression, including delimiters. 882 Groups 2 and 4 matches the opening and closing delimiters. 883 Group 3 matches the text inside the delimiters.") 884 885 (defconst markdown-regex-blockquote 886 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" 887 "Regular expression for matching blockquote lines. 888 Also accounts for a potential capital letter preceding the angle 889 bracket, for use with Leanpub blocks (asides, warnings, info 890 blocks, etc.). 891 Group 1 matches the leading angle bracket. 892 Group 2 matches the separating whitespace. 893 Group 3 matches the text.") 894 895 (defconst markdown-regex-line-break 896 "[^ \n\t][ \t]*\\( \\)\n" 897 "Regular expression for matching line breaks.") 898 899 (defconst markdown-regex-escape 900 "\\(\\\\\\)." 901 "Regular expression for matching escape sequences.") 902 903 (defconst markdown-regex-wiki-link 904 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" 905 "Regular expression for matching wiki links. 906 This matches typical bracketed [[WikiLinks]] as well as \\='aliased 907 wiki links of the form [[PageName|link text]]. 908 The meanings of the first and second components depend 909 on the value of `markdown-wiki-link-alias-first'. 910 911 Group 1 matches the entire link. 912 Group 2 matches the opening square brackets. 913 Group 3 matches the first component of the wiki link. 914 Group 4 matches the pipe separator, when present. 915 Group 5 matches the second component of the wiki link, when present. 916 Group 6 matches the closing square brackets.") 917 918 (defconst markdown-regex-uri 919 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") 920 "Regular expression for matching inline URIs.") 921 922 ;; CommanMark specification says scheme length is 2-32 characters 923 (defconst markdown-regex-angle-uri 924 (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") 925 "Regular expression for matching inline URIs in angle brackets.") 926 927 (defconst markdown-regex-email 928 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" 929 "Regular expression for matching inline email addresses.") 930 931 (defsubst markdown-make-regex-link-generic () 932 "Make regular expression for matching any recognized link." 933 (concat "\\(?:" markdown-regex-link-inline 934 (when markdown-enable-wiki-links 935 (concat "\\|" markdown-regex-wiki-link)) 936 "\\|" markdown-regex-link-reference 937 "\\|" markdown-regex-angle-uri "\\)")) 938 939 (defconst markdown-regex-gfm-checkbox 940 " \\(\\[[ xX]\\]\\) " 941 "Regular expression for matching GFM checkboxes. 942 Group 1 matches the text to become a button.") 943 944 (defconst markdown-regex-blank-line 945 "^[[:blank:]]*$" 946 "Regular expression that matches a blank line.") 947 948 (defconst markdown-regex-block-separator 949 "\n[\n\t\f ]*\n" 950 "Regular expression for matching block boundaries.") 951 952 (defconst markdown-regex-block-separator-noindent 953 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") 954 "Regexp for block separators before lines with no indentation.") 955 956 (defconst markdown-regex-math-inline-single 957 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" 958 "Regular expression for itex $..$ math mode expressions. 959 Groups 1 and 3 match the opening and closing dollar signs. 960 Group 2 matches the mathematical expression contained within.") 961 962 (defconst markdown-regex-math-inline-double 963 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" 964 "Regular expression for itex $$..$$ math mode expressions. 965 Groups 1 and 3 match opening and closing dollar signs. 966 Group 2 matches the mathematical expression contained within.") 967 968 (defconst markdown-regex-math-display 969 (rx line-start (* blank) 970 (group (group (repeat 1 2 "\\")) "[") 971 (group (*? anything)) 972 (group (backref 2) "]") 973 line-end) 974 "Regular expression for \[..\] or \\[..\\] display math. 975 Groups 1 and 4 match the opening and closing markup. 976 Group 3 matches the mathematical expression contained within. 977 Group 2 matches the opening slashes, and is used internally to 978 match the closing slashes.") 979 980 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) 981 "Return regexp matching a tilde code fence at least NUM-TILDES long. 982 END-OF-LINE is the regexp construct to indicate end of line; $ if 983 missing." 984 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" 985 (or end-of-line "$"))) 986 987 (defconst markdown-regex-tilde-fence-begin 988 (markdown-make-tilde-fence-regex 989 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") 990 "Regular expression for matching tilde-fenced code blocks. 991 Group 1 matches the opening tildes. 992 Group 2 matches (optional) opening brace and surrounding whitespace. 993 Group 3 matches the language identifier (optional). 994 Group 4 matches the info string (optional). 995 Group 5 matches the closing brace (optional) and any surrounding whitespace. 996 Groups need to agree with `markdown-regex-gfm-code-block-open'.") 997 998 (defconst markdown-regex-declarative-metadata 999 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" 1000 "Regular expression for matching declarative metadata statements. 1001 This matches MultiMarkdown metadata as well as YAML and TOML 1002 assignments such as the following: 1003 1004 variable: value 1005 1006 or 1007 1008 variable = value") 1009 1010 (defconst markdown-regex-pandoc-metadata 1011 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" 1012 "Regular expression for matching Pandoc metadata.") 1013 1014 (defconst markdown-regex-yaml-metadata-border 1015 "\\(-\\{3\\}\\)$" 1016 "Regular expression for matching YAML metadata.") 1017 1018 (defconst markdown-regex-yaml-pandoc-metadata-end-border 1019 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" 1020 "Regular expression for matching YAML metadata end borders.") 1021 1022 (defsubst markdown-get-yaml-metadata-start-border () 1023 "Return YAML metadata start border depending upon whether Pandoc is used." 1024 (concat 1025 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") 1026 markdown-regex-yaml-metadata-border)) 1027 1028 (defsubst markdown-get-yaml-metadata-end-border (_) 1029 "Return YAML metadata end border depending upon whether Pandoc is used." 1030 (if markdown-use-pandoc-style-yaml-metadata 1031 markdown-regex-yaml-pandoc-metadata-end-border 1032 markdown-regex-yaml-metadata-border)) 1033 1034 (defconst markdown-regex-inline-attributes 1035 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" 1036 "Regular expression for matching inline identifiers or attribute lists. 1037 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") 1038 1039 (defconst markdown-regex-leanpub-sections 1040 (concat 1041 "^\\({\\)\\(" 1042 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) 1043 "\\)\\(}\\)[ \t]*\n") 1044 "Regular expression for Leanpub section markers and related syntax.") 1045 1046 (defconst markdown-regex-sub-superscript 1047 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" 1048 "The regular expression matching a sub- or superscript. 1049 The leading un-numbered group matches the character before the 1050 opening tilde or carat, if any, ensuring that it is not a 1051 backslash escape, carat, or tilde. 1052 Group 1 matches the entire expression, including markup. 1053 Group 2 matches the opening markup--a tilde or carat. 1054 Group 3 matches the text inside the delimiters. 1055 Group 4 matches the closing markup--a tilde or carat.") 1056 1057 (defconst markdown-regex-include 1058 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" 1059 "Regular expression matching common forms of include syntax. 1060 Marked 2, Leanpub, and other processors support some of these forms: 1061 1062 <<[sections/section1.md] 1063 <<(folder/filename) 1064 <<[Code title](folder/filename) 1065 <<{folder/raw_file.html} 1066 1067 Group 1 matches the opening two angle brackets. 1068 Groups 2-4 match the opening square bracket, the text inside, 1069 and the closing square bracket, respectively. 1070 Groups 5-7 match the opening parenthesis, the text inside, and 1071 the closing parenthesis. 1072 Groups 8-10 match the opening brace, the text inside, and the brace.") 1073 1074 (defconst markdown-regex-pandoc-inline-footnote 1075 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" 1076 "Regular expression for Pandoc inline footnote^[footnote text]. 1077 Group 1 matches the opening caret. 1078 Group 2 matches the opening square bracket. 1079 Group 3 matches the footnote text, without the surrounding markup. 1080 Group 4 matches the closing square bracket.") 1081 1082 (defconst markdown-regex-html-attr 1083 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" 1084 "Regular expression for matching HTML attributes and values. 1085 Group 1 matches the attribute name. 1086 Group 2 matches the following whitespace, equals sign, and value, if any. 1087 Group 3 matches the equals sign, if any. 1088 Group 4 matches single-, double-, or un-quoted attribute values.") 1089 1090 (defconst markdown-regex-html-tag 1091 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr 1092 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") 1093 "Regular expression for matching HTML tags. 1094 Groups 1 and 9 match the beginning and ending angle brackets and slashes. 1095 Group 2 matches the tag name. 1096 Group 3 matches all attributes and whitespace following the tag name.") 1097 1098 (defconst markdown-regex-html-entity 1099 "\\(&#?[[:alnum:]]+;\\)" 1100 "Regular expression for matching HTML entities.") 1101 1102 (defconst markdown-regex-highlighting 1103 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" 1104 "Regular expression for matching highlighting text. 1105 Group 1 matches the character before the opening equal, if any, 1106 ensuring that it is not a backslash escape. 1107 Group 2 matches the entire expression, including delimiters. 1108 Groups 3 and 5 matches the opening and closing delimiters. 1109 Group 4 matches the text inside the delimiters.") 1110 1111 1112 ;;; Syntax ==================================================================== 1113 1114 (defvar markdown--syntax-properties 1115 (list 'markdown-tilde-fence-begin nil 1116 'markdown-tilde-fence-end nil 1117 'markdown-fenced-code nil 1118 'markdown-yaml-metadata-begin nil 1119 'markdown-yaml-metadata-end nil 1120 'markdown-yaml-metadata-section nil 1121 'markdown-gfm-block-begin nil 1122 'markdown-gfm-block-end nil 1123 'markdown-gfm-code nil 1124 'markdown-list-item nil 1125 'markdown-pre nil 1126 'markdown-blockquote nil 1127 'markdown-hr nil 1128 'markdown-comment nil 1129 'markdown-heading nil 1130 'markdown-heading-1-setext nil 1131 'markdown-heading-2-setext nil 1132 'markdown-heading-1-atx nil 1133 'markdown-heading-2-atx nil 1134 'markdown-heading-3-atx nil 1135 'markdown-heading-4-atx nil 1136 'markdown-heading-5-atx nil 1137 'markdown-heading-6-atx nil 1138 'markdown-metadata-key nil 1139 'markdown-metadata-value nil 1140 'markdown-metadata-markup nil) 1141 "Property list of all Markdown syntactic properties.") 1142 1143 (defvar markdown-literal-faces 1144 '(markdown-inline-code-face 1145 markdown-pre-face 1146 markdown-math-face 1147 markdown-url-face 1148 markdown-plain-url-face 1149 markdown-language-keyword-face 1150 markdown-language-info-face 1151 markdown-metadata-key-face 1152 markdown-metadata-value-face 1153 markdown-html-entity-face 1154 markdown-html-tag-name-face 1155 markdown-html-tag-delimiter-face 1156 markdown-html-attr-name-face 1157 markdown-html-attr-value-face 1158 markdown-reference-face 1159 markdown-footnote-marker-face 1160 markdown-line-break-face 1161 markdown-comment-face) 1162 "A list of markdown-mode faces that contain literal text. 1163 Literal text treats backslashes literally, rather than as an 1164 escape character (see `markdown-match-escape').") 1165 1166 (defsubst markdown-in-comment-p (&optional pos) 1167 "Return non-nil if POS is in a comment. 1168 If POS is not given, use point instead." 1169 (get-text-property (or pos (point)) 'markdown-comment)) 1170 1171 (defun markdown--face-p (pos faces) 1172 "Return non-nil if face of POS contain FACES." 1173 (let ((face-prop (get-text-property pos 'face))) 1174 (if (listp face-prop) 1175 (cl-loop for face in face-prop 1176 thereis (memq face faces)) 1177 (memq face-prop faces)))) 1178 1179 (defsubst markdown--math-block-p (&optional pos) 1180 (when markdown-enable-math 1181 (markdown--face-p (or pos (point)) '(markdown-math-face)))) 1182 1183 (defun markdown-syntax-propertize-extend-region (start end) 1184 "Extend START to END region to include an entire block of text. 1185 This helps improve syntax analysis for block constructs. 1186 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. 1187 Function is called repeatedly until it returns nil. For details, see 1188 `syntax-propertize-extend-region-functions'." 1189 (save-match-data 1190 (save-excursion 1191 (let* ((new-start (progn (goto-char start) 1192 (skip-chars-forward "\n") 1193 (if (re-search-backward "\n\n" nil t) 1194 (min start (match-end 0)) 1195 (point-min)))) 1196 (new-end (progn (goto-char end) 1197 (skip-chars-backward "\n") 1198 (if (re-search-forward "\n\n" nil t) 1199 (max end (match-beginning 0)) 1200 (point-max)))) 1201 (code-match (markdown-code-block-at-pos new-start)) 1202 ;; FIXME: The `code-match' can return bogus values 1203 ;; when text has been inserted/deleted! 1204 (new-start (min (or (and code-match (cl-first code-match)) 1205 (point-max)) 1206 new-start)) 1207 (code-match (and (< end (point-max)) 1208 (markdown-code-block-at-pos end))) 1209 (new-end (max (or (and code-match (cl-second code-match)) 0) 1210 new-end))) 1211 1212 (unless (and (eq new-start start) (eq new-end end)) 1213 (cons new-start (min new-end (point-max)))))))) 1214 1215 (defun markdown-font-lock-extend-region-function (start end _) 1216 "Used in `jit-lock-after-change-extend-region-functions'. 1217 Delegates to `markdown-syntax-propertize-extend-region'. START 1218 and END are the previous region to refontify." 1219 (let ((res (markdown-syntax-propertize-extend-region start end))) 1220 (when res 1221 ;; syntax-propertize-function is not called when character at 1222 ;; (point-max) is deleted, but font-lock-extend-region-functions 1223 ;; are called. Force a syntax property update in that case. 1224 (when (= end (point-max)) 1225 ;; This function is called in a buffer modification hook. 1226 ;; `markdown-syntax-propertize' doesn't save the match data, 1227 ;; so we have to do it here. 1228 (save-match-data 1229 (markdown-syntax-propertize (car res) (cdr res)))) 1230 (setq jit-lock-start (car res) 1231 jit-lock-end (cdr res))))) 1232 1233 (defun markdown--cur-list-item-bounds () 1234 "Return a list describing the list item at point. 1235 Assumes that match data is set for `markdown-regex-list'. See the 1236 documentation for `markdown-cur-list-item-bounds' for the format of 1237 the returned list." 1238 (save-excursion 1239 (let* ((begin (match-beginning 0)) 1240 (indent (length (match-string-no-properties 1))) 1241 (nonlist-indent (- (match-end 3) (match-beginning 0))) 1242 (marker (buffer-substring-no-properties 1243 (match-beginning 2) (match-end 3))) 1244 (checkbox (match-string-no-properties 4)) 1245 (match (butlast (match-data t))) 1246 (end (markdown-cur-list-item-end nonlist-indent))) 1247 (list begin end indent nonlist-indent marker checkbox match)))) 1248 1249 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) 1250 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. 1251 Here, MARKER is a string representing the type of list and INDENT 1252 is an integer giving the indentation, in spaces, of the current 1253 block. CUR-BOUNDS is a list of the form returned by 1254 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds 1255 values for parent list items. When BOUNDS is nil, it means we are 1256 at baseline (not inside of a nested list)." 1257 (let ((prev-indent (or (cl-third (car bounds)) 0))) 1258 (cond 1259 ;; New list item at baseline. 1260 ((and marker (null bounds)) 1261 (list cur-bounds)) 1262 ;; List item with greater indentation (four or more spaces). 1263 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. 1264 ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) 1265 (cons cur-bounds bounds)) 1266 ;; List item with greater or equal indentation (less than four spaces). 1267 ;; Keep list level the same by replacing the car of BOUNDS. 1268 ((and marker (>= indent prev-indent)) 1269 (cons cur-bounds (cdr bounds))) 1270 ;; Lesser indentation level. 1271 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser 1272 ;; indentation could move back more than one list level). Note 1273 ;; that this block need not be the beginning of list item. 1274 ((< indent prev-indent) 1275 (while (and (> (length bounds) 1) 1276 (setq prev-indent (cl-third (cadr bounds))) 1277 (< indent (+ prev-indent markdown-list-indent-width))) 1278 (setq bounds (cdr bounds))) 1279 (cons cur-bounds bounds)) 1280 ;; Otherwise, do nothing. 1281 (t bounds)))) 1282 1283 (defun markdown-syntax-propertize-list-items (start end) 1284 "Propertize list items from START to END. 1285 Stores nested list item information in the `markdown-list-item' 1286 text property to make later syntax analysis easier. The value of 1287 this property is a list with elements of the form (begin . end) 1288 giving the bounds of the current and parent list items." 1289 (save-excursion 1290 (goto-char start) 1291 (let ((prev-list-line -100) 1292 bounds level pre-regexp) 1293 ;; Find a baseline point with zero list indentation 1294 (markdown-search-backward-baseline) 1295 ;; Search for all list items between baseline and END 1296 (while (and (< (point) end) 1297 (re-search-forward markdown-regex-list end 'limit)) 1298 ;; Level of list nesting 1299 (setq level (length bounds)) 1300 ;; Pre blocks need to be indented one level past the list level 1301 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) 1302 (beginning-of-line) 1303 (cond 1304 ;; Reset at headings, horizontal rules, and top-level blank lines. 1305 ;; Propertize baseline when in range. 1306 ((markdown-new-baseline) 1307 (setq bounds nil)) 1308 ;; Make sure this is not a line from a pre block 1309 ((and (looking-at-p pre-regexp) 1310 ;; too indented line is also treated as list if previous line is list 1311 (>= (- (line-number-at-pos) prev-list-line) 2))) 1312 ;; If not, then update levels and propertize list item when in range. 1313 (t 1314 (let* ((indent (current-indentation)) 1315 (cur-bounds (markdown--cur-list-item-bounds)) 1316 (first (cl-first cur-bounds)) 1317 (last (cl-second cur-bounds)) 1318 (marker (cl-fifth cur-bounds))) 1319 (setq bounds (markdown--append-list-item-bounds 1320 marker indent cur-bounds bounds)) 1321 (when (and (<= start (point)) (<= (point) end)) 1322 (setq prev-list-line (line-number-at-pos first)) 1323 (put-text-property first last 'markdown-list-item bounds))))) 1324 (end-of-line))))) 1325 1326 (defun markdown-syntax-propertize-pre-blocks (start end) 1327 "Match preformatted text blocks from START to END." 1328 (save-excursion 1329 (goto-char start) 1330 (let (finish) 1331 ;; Use loop for avoiding too many recursive calls 1332 ;; https://github.com/jrblevin/markdown-mode/issues/512 1333 (while (not finish) 1334 (let ((levels (markdown-calculate-list-levels)) 1335 indent pre-regexp close-regexp open close) 1336 (while (and (< (point) end) (not close)) 1337 ;; Search for a region with sufficient indentation 1338 (if (null levels) 1339 (setq indent 1) 1340 (setq indent (1+ (length levels)))) 1341 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) 1342 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) 1343 1344 (cond 1345 ;; If not at the beginning of a line, move forward 1346 ((not (bolp)) (forward-line)) 1347 ;; Move past blank lines 1348 ((markdown-cur-line-blank-p) (forward-line)) 1349 ;; At headers and horizontal rules, reset levels 1350 ((markdown-new-baseline) (forward-line) (setq levels nil)) 1351 ;; If the current line has sufficient indentation, mark out pre block 1352 ;; The opening should be preceded by a blank line. 1353 ((and (markdown-prev-line-blank) (looking-at pre-regexp)) 1354 (setq open (match-beginning 0)) 1355 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) 1356 (not (eobp))) 1357 (forward-line)) 1358 (skip-syntax-backward "-") 1359 (forward-line) 1360 (setq close (point))) 1361 ;; If current line has a list marker, update levels, move to end of block 1362 ((looking-at markdown-regex-list) 1363 (setq levels (markdown-update-list-levels 1364 (match-string 2) (current-indentation) levels)) 1365 (markdown-end-of-text-block)) 1366 ;; If this is the end of the indentation level, adjust levels accordingly. 1367 ;; Only match end of indentation level if levels is not the empty list. 1368 ((and (car levels) (looking-at-p close-regexp)) 1369 (setq levels (markdown-update-list-levels 1370 nil (current-indentation) levels)) 1371 (markdown-end-of-text-block)) 1372 (t (markdown-end-of-text-block)))) 1373 1374 (if (and open close) 1375 ;; Set text property data and continue to search 1376 (put-text-property open close 'markdown-pre (list open close)) 1377 (setq finish t)))) 1378 nil))) 1379 1380 (defconst markdown-fenced-block-pairs 1381 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) 1382 (markdown-make-tilde-fence-regex markdown-tilde-fence-end) 1383 markdown-fenced-code) 1384 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) 1385 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) 1386 markdown-yaml-metadata-section) 1387 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) 1388 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) 1389 markdown-gfm-code)) 1390 "Mapping of regular expressions to \"fenced-block\" constructs. 1391 These constructs are distinguished by having a distinctive start 1392 and end pattern, both of which take up an entire line of text, 1393 but no special pattern to identify text within the fenced 1394 blocks (unlike blockquotes and indented-code sections). 1395 1396 Each element within this list takes the form: 1397 1398 ((START-REGEX-OR-FUN START-PROPERTY) 1399 (END-REGEX-OR-FUN END-PROPERTY) 1400 MIDDLE-PROPERTY) 1401 1402 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a 1403 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no 1404 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument 1405 which is the length of the first group of the START-REGEX-OR-FUN match, which 1406 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to 1407 evaluate these into \"real\" regexps. 1408 1409 The *-PROPERTY elements are the text properties applied to each part of the 1410 block construct when it is matched using 1411 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied 1412 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and 1413 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the 1414 `match-data' when the regexp was matched to the text. In the case of 1415 MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with 1416 begin and end set to the edges of the \"middle\" text. This makes fontification 1417 easier.") 1418 1419 (defun markdown-text-property-at-point (prop) 1420 (get-text-property (point) prop)) 1421 1422 (defsubst markdown-maybe-funcall-regexp (object &optional arg) 1423 (cond ((functionp object) 1424 (if arg (funcall object arg) (funcall object))) 1425 ((stringp object) object) 1426 (t (error "Object cannot be turned into regex")))) 1427 1428 (defsubst markdown-get-start-fence-regexp () 1429 "Return regexp to find all \"start\" sections of fenced block constructs. 1430 Which construct is actually contained in the match must be found separately." 1431 (mapconcat 1432 #'identity 1433 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) 1434 markdown-fenced-block-pairs) 1435 "\\|")) 1436 1437 (defun markdown-get-fenced-block-begin-properties () 1438 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) 1439 1440 (defun markdown-get-fenced-block-end-properties () 1441 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) 1442 1443 (defun markdown-get-fenced-block-middle-properties () 1444 (cl-mapcar #'cl-third markdown-fenced-block-pairs)) 1445 1446 (defun markdown-find-previous-prop (prop &optional lim) 1447 "Find previous place where property PROP is non-nil, up to LIM. 1448 Return a cons of (pos . property). pos is point if point contains 1449 non-nil PROP." 1450 (let ((res 1451 (if (get-text-property (point) prop) (point) 1452 (previous-single-property-change 1453 (point) prop nil (or lim (point-min)))))) 1454 (when (and (not (get-text-property res prop)) 1455 (> res (point-min)) 1456 (get-text-property (1- res) prop)) 1457 (cl-decf res)) 1458 (when (and res (get-text-property res prop)) (cons res prop)))) 1459 1460 (defun markdown-find-next-prop (prop &optional lim) 1461 "Find next place where property PROP is non-nil, up to LIM. 1462 Return a cons of (POS . PROPERTY) where POS is point if point 1463 contains non-nil PROP." 1464 (let ((res 1465 (if (get-text-property (point) prop) (point) 1466 (next-single-property-change 1467 (point) prop nil (or lim (point-max)))))) 1468 (when (and res (get-text-property res prop)) (cons res prop)))) 1469 1470 (defun markdown-min-of-seq (map-fn seq) 1471 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." 1472 (cl-loop for el in seq 1473 with min = 1.0e+INF ; infinity 1474 with min-el = nil 1475 do (let ((res (funcall map-fn el))) 1476 (when (< res min) 1477 (setq min res) 1478 (setq min-el el))) 1479 finally return min-el)) 1480 1481 (defun markdown-max-of-seq (map-fn seq) 1482 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." 1483 (cl-loop for el in seq 1484 with max = -1.0e+INF ; negative infinity 1485 with max-el = nil 1486 do (let ((res (funcall map-fn el))) 1487 (when (and res (> res max)) 1488 (setq max res) 1489 (setq max-el el))) 1490 finally return max-el)) 1491 1492 (defun markdown-find-previous-block () 1493 "Find previous block. 1494 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was 1495 unable to propertize the entire block, but was able to propertize the beginning 1496 of the block. If so, return a cons of (pos . property) where the beginning of 1497 the block was propertized." 1498 (let ((start-pt (point)) 1499 (closest-open 1500 (markdown-max-of-seq 1501 #'car 1502 (cl-remove-if 1503 #'null 1504 (cl-mapcar 1505 #'markdown-find-previous-prop 1506 (markdown-get-fenced-block-begin-properties)))))) 1507 (when closest-open 1508 (let* ((length-of-open-match 1509 (let ((match-d 1510 (get-text-property (car closest-open) (cdr closest-open)))) 1511 (- (cl-fourth match-d) (cl-third match-d)))) 1512 (end-regexp 1513 (markdown-maybe-funcall-regexp 1514 (cl-caadr 1515 (cl-find-if 1516 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) 1517 markdown-fenced-block-pairs)) 1518 length-of-open-match)) 1519 (end-prop-loc 1520 (save-excursion 1521 (save-match-data 1522 (goto-char (car closest-open)) 1523 (and (re-search-forward end-regexp start-pt t) 1524 (match-beginning 0)))))) 1525 (and (not end-prop-loc) closest-open))))) 1526 1527 (defun markdown-get-fenced-block-from-start (prop) 1528 "Return limits of an enclosing fenced block from its start, using PROP. 1529 Return value is a list usable as `match-data'." 1530 (catch 'no-rest-of-block 1531 (let* ((correct-entry 1532 (cl-find-if 1533 (lambda (entry) (eq (cl-cadar entry) prop)) 1534 markdown-fenced-block-pairs)) 1535 (begin-of-begin (cl-first (markdown-text-property-at-point prop))) 1536 (middle-prop (cl-third correct-entry)) 1537 (end-prop (cl-cadadr correct-entry)) 1538 (end-of-end 1539 (save-excursion 1540 (goto-char (match-end 0)) ; end of begin 1541 (unless (eobp) (forward-char)) 1542 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1543 (if (not mid-prop-v) ; no middle 1544 (progn 1545 ;; try to find end by advancing one 1546 (let ((end-prop-v 1547 (markdown-text-property-at-point end-prop))) 1548 (if end-prop-v (cl-second end-prop-v) 1549 (throw 'no-rest-of-block nil)))) 1550 (set-match-data mid-prop-v) 1551 (goto-char (match-end 0)) ; end of middle 1552 (beginning-of-line) ; into end 1553 (cl-second (markdown-text-property-at-point end-prop))))))) 1554 (list begin-of-begin end-of-end)))) 1555 1556 (defun markdown-get-fenced-block-from-middle (prop) 1557 "Return limits of an enclosing fenced block from its middle, using PROP. 1558 Return value is a list usable as `match-data'." 1559 (let* ((correct-entry 1560 (cl-find-if 1561 (lambda (entry) (eq (cl-third entry) prop)) 1562 markdown-fenced-block-pairs)) 1563 (begin-prop (cl-cadar correct-entry)) 1564 (begin-of-begin 1565 (save-excursion 1566 (goto-char (match-beginning 0)) 1567 (unless (bobp) (forward-line -1)) 1568 (beginning-of-line) 1569 (cl-first (markdown-text-property-at-point begin-prop)))) 1570 (end-prop (cl-cadadr correct-entry)) 1571 (end-of-end 1572 (save-excursion 1573 (goto-char (match-end 0)) 1574 (beginning-of-line) 1575 (cl-second (markdown-text-property-at-point end-prop))))) 1576 (list begin-of-begin end-of-end))) 1577 1578 (defun markdown-get-fenced-block-from-end (prop) 1579 "Return limits of an enclosing fenced block from its end, using PROP. 1580 Return value is a list usable as `match-data'." 1581 (let* ((correct-entry 1582 (cl-find-if 1583 (lambda (entry) (eq (cl-cadadr entry) prop)) 1584 markdown-fenced-block-pairs)) 1585 (end-of-end (cl-second (markdown-text-property-at-point prop))) 1586 (middle-prop (cl-third correct-entry)) 1587 (begin-prop (cl-cadar correct-entry)) 1588 (begin-of-begin 1589 (save-excursion 1590 (goto-char (match-beginning 0)) ; beginning of end 1591 (unless (bobp) (backward-char)) ; into middle 1592 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1593 (if (not mid-prop-v) 1594 (progn 1595 (beginning-of-line) 1596 (cl-first (markdown-text-property-at-point begin-prop))) 1597 (set-match-data mid-prop-v) 1598 (goto-char (match-beginning 0)) ; beginning of middle 1599 (unless (bobp) (forward-line -1)) ; into beginning 1600 (beginning-of-line) 1601 (cl-first (markdown-text-property-at-point begin-prop))))))) 1602 (list begin-of-begin end-of-end))) 1603 1604 (defun markdown-get-enclosing-fenced-block-construct (&optional pos) 1605 "Get \"fake\" match data for block enclosing POS. 1606 Returns fake match data which encloses the start, middle, and end 1607 of the block construct enclosing POS, if it exists. Used in 1608 `markdown-code-block-at-pos'." 1609 (save-excursion 1610 (when pos (goto-char pos)) 1611 (beginning-of-line) 1612 (car 1613 (cl-remove-if 1614 #'null 1615 (cl-mapcar 1616 (lambda (fun-and-prop) 1617 (cl-destructuring-bind (fun prop) fun-and-prop 1618 (when prop 1619 (save-match-data 1620 (set-match-data (markdown-text-property-at-point prop)) 1621 (funcall fun prop))))) 1622 `((markdown-get-fenced-block-from-start 1623 ,(cl-find-if 1624 #'markdown-text-property-at-point 1625 (markdown-get-fenced-block-begin-properties))) 1626 (markdown-get-fenced-block-from-middle 1627 ,(cl-find-if 1628 #'markdown-text-property-at-point 1629 (markdown-get-fenced-block-middle-properties))) 1630 (markdown-get-fenced-block-from-end 1631 ,(cl-find-if 1632 #'markdown-text-property-at-point 1633 (markdown-get-fenced-block-end-properties))))))))) 1634 1635 (defun markdown-propertize-end-match (reg end fence-spec middle-begin) 1636 "Get match for REG up to END, if exists, and propertize appropriately. 1637 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and 1638 MIDDLE-BEGIN is the start of the \"middle\" section of the block." 1639 (when (re-search-forward reg end t) 1640 (let ((close-begin (match-beginning 0)) ; Start of closing line. 1641 (close-end (match-end 0)) ; End of closing line. 1642 (close-data (match-data t))) ; Match data for closing line. 1643 ;; Propertize middle section of fenced block. 1644 (put-text-property middle-begin close-begin 1645 (cl-third fence-spec) 1646 (list middle-begin close-begin)) 1647 ;; If the block is a YAML block, propertize the declarations inside 1648 (when (< middle-begin close-begin) ;; workaround #634 1649 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) 1650 ;; Propertize closing line of fenced block. 1651 (put-text-property close-begin close-end 1652 (cl-cadadr fence-spec) close-data)))) 1653 1654 (defun markdown--triple-quote-single-line-p (begin) 1655 (save-excursion 1656 (goto-char begin) 1657 (save-match-data 1658 (and (search-forward "```" nil t) 1659 (search-forward "```" (line-end-position) t))))) 1660 1661 (defun markdown-syntax-propertize-fenced-block-constructs (start end) 1662 "Propertize according to `markdown-fenced-block-pairs' from START to END. 1663 If unable to propertize an entire block (if the start of a block is within START 1664 and END, but the end of the block is not), propertize the start section of a 1665 block, then in a subsequent call propertize both middle and end by finding the 1666 start which was previously propertized." 1667 (let ((start-reg (markdown-get-start-fence-regexp))) 1668 (save-excursion 1669 (goto-char start) 1670 ;; start from previous unclosed block, if exists 1671 (let ((prev-begin-block (markdown-find-previous-block))) 1672 (when prev-begin-block 1673 (let* ((correct-entry 1674 (cl-find-if (lambda (entry) 1675 (eq (cdr prev-begin-block) (cl-cadar entry))) 1676 markdown-fenced-block-pairs)) 1677 (enclosed-text-start (1+ (car prev-begin-block))) 1678 (start-length 1679 (save-excursion 1680 (goto-char (car prev-begin-block)) 1681 (string-match 1682 (markdown-maybe-funcall-regexp 1683 (caar correct-entry)) 1684 (buffer-substring 1685 (line-beginning-position) (line-end-position))) 1686 (- (match-end 1) (match-beginning 1)))) 1687 (end-reg (markdown-maybe-funcall-regexp 1688 (cl-caadr correct-entry) start-length))) 1689 (markdown-propertize-end-match 1690 end-reg end correct-entry enclosed-text-start)))) 1691 ;; find all new blocks within region 1692 (while (re-search-forward start-reg end t) 1693 ;; we assume the opening constructs take up (only) an entire line, 1694 ;; so we re-check the current line 1695 (let* ((block-start (match-beginning 0)) 1696 (cur-line (buffer-substring (line-beginning-position) (line-end-position))) 1697 ;; find entry in `markdown-fenced-block-pairs' corresponding 1698 ;; to regex which was matched 1699 (correct-entry 1700 (cl-find-if 1701 (lambda (fenced-pair) 1702 (string-match-p 1703 (markdown-maybe-funcall-regexp (caar fenced-pair)) 1704 cur-line)) 1705 markdown-fenced-block-pairs)) 1706 (enclosed-text-start 1707 (save-excursion (1+ (line-end-position)))) 1708 (end-reg 1709 (markdown-maybe-funcall-regexp 1710 (cl-caadr correct-entry) 1711 (if (and (match-beginning 1) (match-end 1)) 1712 (- (match-end 1) (match-beginning 1)) 1713 0))) 1714 (prop (cl-cadar correct-entry))) 1715 (when (or (not (eq prop 'markdown-gfm-block-begin)) 1716 (not (markdown--triple-quote-single-line-p block-start))) 1717 ;; get correct match data 1718 (save-excursion 1719 (beginning-of-line) 1720 (re-search-forward 1721 (markdown-maybe-funcall-regexp (caar correct-entry)) 1722 (line-end-position))) 1723 ;; mark starting, even if ending is outside of region 1724 (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) 1725 (markdown-propertize-end-match 1726 end-reg end correct-entry enclosed-text-start))))))) 1727 1728 (defun markdown-syntax-propertize-blockquotes (start end) 1729 "Match blockquotes from START to END." 1730 (save-excursion 1731 (goto-char start) 1732 (while (and (re-search-forward markdown-regex-blockquote end t) 1733 (not (markdown-code-block-at-pos (match-beginning 0)))) 1734 (put-text-property (match-beginning 0) (match-end 0) 1735 'markdown-blockquote 1736 (match-data t))))) 1737 1738 (defun markdown-syntax-propertize-hrs (start end) 1739 "Match horizontal rules from START to END." 1740 (save-excursion 1741 (goto-char start) 1742 (while (re-search-forward markdown-regex-hr end t) 1743 (let ((beg (match-beginning 0)) 1744 (end (match-end 0))) 1745 (goto-char beg) 1746 (unless (or (markdown-on-heading-p) 1747 (markdown-code-block-at-point-p)) 1748 (put-text-property beg end 'markdown-hr (match-data t))) 1749 (goto-char end))))) 1750 1751 (defun markdown-syntax-propertize-yaml-metadata (start end) 1752 "Propertize elements inside YAML metadata blocks from START to END. 1753 Assumes region from START and END is already known to be the interior 1754 region of a YAML metadata block as propertized by 1755 `markdown-syntax-propertize-fenced-block-constructs'." 1756 (save-excursion 1757 (goto-char start) 1758 (cl-loop 1759 while (re-search-forward markdown-regex-declarative-metadata end t) 1760 do (progn 1761 (put-text-property (match-beginning 1) (match-end 1) 1762 'markdown-metadata-key (match-data t)) 1763 (put-text-property (match-beginning 2) (match-end 2) 1764 'markdown-metadata-markup (match-data t)) 1765 (put-text-property (match-beginning 3) (match-end 3) 1766 'markdown-metadata-value (match-data t)))))) 1767 1768 (defun markdown-syntax-propertize-headings (start end) 1769 "Match headings of type SYMBOL with REGEX from START to END." 1770 (goto-char start) 1771 (while (re-search-forward markdown-regex-header end t) 1772 (unless (markdown-code-block-at-pos (match-beginning 0)) 1773 (put-text-property 1774 (match-beginning 0) (match-end 0) 'markdown-heading 1775 (match-data t)) 1776 (put-text-property 1777 (match-beginning 0) (match-end 0) 1778 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) 1779 ((match-string-no-properties 3) 'markdown-heading-2-setext) 1780 (t (let ((atx-level (length (markdown-trim-whitespace 1781 (match-string-no-properties 4))))) 1782 (intern (format "markdown-heading-%d-atx" atx-level))))) 1783 (match-data t))))) 1784 1785 (defun markdown-syntax-propertize-comments (start end) 1786 "Match HTML comments from the START to END." 1787 ;; Implement by loop instead of recursive call for avoiding 1788 ;; exceed max-lisp-eval-depth issue 1789 ;; https://github.com/jrblevin/markdown-mode/issues/536 1790 (let (finish) 1791 (goto-char start) 1792 (while (not finish) 1793 (let* ((in-comment (nth 4 (syntax-ppss))) 1794 (comment-begin (nth 8 (syntax-ppss)))) 1795 (cond 1796 ;; Comment start 1797 ((and (not in-comment) 1798 (re-search-forward markdown-regex-comment-start end t) 1799 (not (markdown-inline-code-at-point-p)) 1800 (not (markdown-code-block-at-point-p))) 1801 (let ((open-beg (match-beginning 0))) 1802 (put-text-property open-beg (1+ open-beg) 1803 'syntax-table (string-to-syntax "<")) 1804 (goto-char (min (1+ (match-end 0)) end (point-max))))) 1805 ;; Comment end 1806 ((and in-comment comment-begin 1807 (re-search-forward markdown-regex-comment-end end t)) 1808 (let ((comment-end (match-end 0))) 1809 (put-text-property (1- comment-end) comment-end 1810 'syntax-table (string-to-syntax ">")) 1811 ;; Remove any other text properties inside the comment 1812 (remove-text-properties comment-begin comment-end 1813 markdown--syntax-properties) 1814 (put-text-property comment-begin comment-end 1815 'markdown-comment (list comment-begin comment-end)) 1816 (goto-char (min comment-end end (point-max))))) 1817 ;; Nothing found 1818 (t (setq finish t))))) 1819 nil)) 1820 1821 (defun markdown-syntax-propertize (start end) 1822 "Function used as `syntax-propertize-function'. 1823 START and END delimit region to propertize." 1824 (with-silent-modifications 1825 (save-excursion 1826 (remove-text-properties start end markdown--syntax-properties) 1827 (markdown-syntax-propertize-fenced-block-constructs start end) 1828 (markdown-syntax-propertize-list-items start end) 1829 (markdown-syntax-propertize-pre-blocks start end) 1830 (markdown-syntax-propertize-blockquotes start end) 1831 (markdown-syntax-propertize-headings start end) 1832 (markdown-syntax-propertize-hrs start end) 1833 (markdown-syntax-propertize-comments start end)))) 1834 1835 1836 ;;; Markup Hiding ============================================================= 1837 1838 (defconst markdown-markup-properties 1839 '(face markdown-markup-face invisible markdown-markup) 1840 "List of properties and values to apply to markup.") 1841 1842 (defconst markdown-line-break-properties 1843 '(face markdown-line-break-face invisible markdown-markup) 1844 "List of properties and values to apply to line break markup.") 1845 1846 (defconst markdown-language-keyword-properties 1847 '(face markdown-language-keyword-face invisible markdown-markup) 1848 "List of properties and values to apply to code block language names.") 1849 1850 (defconst markdown-language-info-properties 1851 '(face markdown-language-info-face invisible markdown-markup) 1852 "List of properties and values to apply to code block language info strings.") 1853 1854 (defconst markdown-include-title-properties 1855 '(face markdown-link-title-face invisible markdown-markup) 1856 "List of properties and values to apply to included code titles.") 1857 1858 (defcustom markdown-hide-markup nil 1859 "Determines whether markup in the buffer will be hidden. 1860 When set to nil, all markup is displayed in the buffer as it 1861 appears in the file. An exception is when `markdown-hide-urls' 1862 is non-nil. 1863 Set this to a non-nil value to turn this feature on by default. 1864 You can interactively toggle the value of this variable with 1865 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], 1866 or from the Markdown > Show & Hide menu. 1867 1868 Markup hiding works by adding text properties to positions in the 1869 buffer---either the `invisible' property or the `display' property 1870 in cases where alternative glyphs are used (e.g., list bullets). 1871 This does not, however, affect printing or other output. 1872 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will 1873 not honor these text properties. For printing, it would be better 1874 to first convert to HTML or PDF (e.g,. using Pandoc)." 1875 :group 'markdown 1876 :type 'boolean 1877 :safe 'booleanp 1878 :package-version '(markdown-mode . "2.3")) 1879 (make-variable-buffer-local 'markdown-hide-markup) 1880 1881 (defun markdown-toggle-markup-hiding (&optional arg) 1882 "Toggle the display or hiding of markup. 1883 With a prefix argument ARG, enable markup hiding if ARG is positive, 1884 and disable it otherwise. 1885 See `markdown-hide-markup' for additional details." 1886 (interactive (list (or current-prefix-arg 'toggle))) 1887 (setq markdown-hide-markup 1888 (if (eq arg 'toggle) 1889 (not markdown-hide-markup) 1890 (> (prefix-numeric-value arg) 0))) 1891 (if markdown-hide-markup 1892 (add-to-invisibility-spec 'markdown-markup) 1893 (remove-from-invisibility-spec 'markdown-markup)) 1894 (when (called-interactively-p 'interactive) 1895 (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) 1896 (markdown-reload-extensions)) 1897 1898 1899 ;;; Font Lock ================================================================= 1900 1901 (require 'font-lock) 1902 1903 (defgroup markdown-faces nil 1904 "Faces used in Markdown Mode." 1905 :group 'markdown 1906 :group 'faces) 1907 1908 (defface markdown-italic-face 1909 '((t (:inherit italic))) 1910 "Face for italic text." 1911 :group 'markdown-faces) 1912 1913 (defface markdown-bold-face 1914 '((t (:inherit bold))) 1915 "Face for bold text." 1916 :group 'markdown-faces) 1917 1918 (defface markdown-strike-through-face 1919 '((t (:strike-through t))) 1920 "Face for strike-through text." 1921 :group 'markdown-faces) 1922 1923 (defface markdown-markup-face 1924 '((t (:inherit shadow :slant normal :weight normal))) 1925 "Face for markup elements." 1926 :group 'markdown-faces) 1927 1928 (defface markdown-header-rule-face 1929 '((t (:inherit markdown-markup-face))) 1930 "Base face for headers rules." 1931 :group 'markdown-faces) 1932 1933 (defface markdown-header-delimiter-face 1934 '((t (:inherit markdown-markup-face))) 1935 "Base face for headers hash delimiter." 1936 :group 'markdown-faces) 1937 1938 (defface markdown-list-face 1939 '((t (:inherit markdown-markup-face))) 1940 "Face for list item markers." 1941 :group 'markdown-faces) 1942 1943 (defface markdown-blockquote-face 1944 '((t (:inherit font-lock-doc-face))) 1945 "Face for blockquote sections." 1946 :group 'markdown-faces) 1947 1948 (defface markdown-code-face 1949 '((t (:inherit fixed-pitch))) 1950 "Face for inline code, pre blocks, and fenced code blocks. 1951 This may be used, for example, to add a contrasting background to 1952 inline code fragments and code blocks." 1953 :group 'markdown-faces) 1954 1955 (defface markdown-inline-code-face 1956 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1957 "Face for inline code." 1958 :group 'markdown-faces) 1959 1960 (defface markdown-pre-face 1961 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1962 "Face for preformatted text." 1963 :group 'markdown-faces) 1964 1965 (defface markdown-table-face 1966 '((t (:inherit (markdown-code-face)))) 1967 "Face for tables." 1968 :group 'markdown-faces) 1969 1970 (defface markdown-language-keyword-face 1971 '((t (:inherit font-lock-type-face))) 1972 "Face for programming language identifiers." 1973 :group 'markdown-faces) 1974 1975 (defface markdown-language-info-face 1976 '((t (:inherit font-lock-string-face))) 1977 "Face for programming language info strings." 1978 :group 'markdown-faces) 1979 1980 (defface markdown-link-face 1981 '((t (:inherit link))) 1982 "Face for links." 1983 :group 'markdown-faces) 1984 1985 (defface markdown-missing-link-face 1986 '((t (:inherit font-lock-warning-face))) 1987 "Face for missing links." 1988 :group 'markdown-faces) 1989 1990 (defface markdown-reference-face 1991 '((t (:inherit markdown-markup-face))) 1992 "Face for link references." 1993 :group 'markdown-faces) 1994 1995 (defface markdown-footnote-marker-face 1996 '((t (:inherit markdown-markup-face))) 1997 "Face for footnote markers." 1998 :group 'markdown-faces) 1999 2000 (defface markdown-footnote-text-face 2001 '((t (:inherit font-lock-comment-face))) 2002 "Face for footnote text." 2003 :group 'markdown-faces) 2004 2005 (defface markdown-url-face 2006 '((t (:inherit font-lock-string-face))) 2007 "Face for URLs that are part of markup. 2008 For example, this applies to URLs in inline links: 2009 [link text](http://example.com/)." 2010 :group 'markdown-faces) 2011 2012 (defface markdown-plain-url-face 2013 '((t (:inherit markdown-link-face))) 2014 "Face for URLs that are also links. 2015 For example, this applies to plain angle bracket URLs: 2016 <http://example.com/>." 2017 :group 'markdown-faces) 2018 2019 (defface markdown-link-title-face 2020 '((t (:inherit font-lock-comment-face))) 2021 "Face for reference link titles." 2022 :group 'markdown-faces) 2023 2024 (defface markdown-line-break-face 2025 '((t (:inherit font-lock-constant-face :underline t))) 2026 "Face for hard line breaks." 2027 :group 'markdown-faces) 2028 2029 (defface markdown-comment-face 2030 '((t (:inherit font-lock-comment-face))) 2031 "Face for HTML comments." 2032 :group 'markdown-faces) 2033 2034 (defface markdown-math-face 2035 '((t (:inherit font-lock-string-face))) 2036 "Face for LaTeX expressions." 2037 :group 'markdown-faces) 2038 2039 (defface markdown-metadata-key-face 2040 '((t (:inherit font-lock-variable-name-face))) 2041 "Face for metadata keys." 2042 :group 'markdown-faces) 2043 2044 (defface markdown-metadata-value-face 2045 '((t (:inherit font-lock-string-face))) 2046 "Face for metadata values." 2047 :group 'markdown-faces) 2048 2049 (defface markdown-gfm-checkbox-face 2050 '((t (:inherit font-lock-builtin-face))) 2051 "Face for GFM checkboxes." 2052 :group 'markdown-faces) 2053 2054 (defface markdown-highlight-face 2055 '((t (:inherit highlight))) 2056 "Face for mouse highlighting." 2057 :group 'markdown-faces) 2058 2059 (defface markdown-hr-face 2060 '((t (:inherit markdown-markup-face))) 2061 "Face for horizontal rules." 2062 :group 'markdown-faces) 2063 2064 (defface markdown-html-tag-name-face 2065 '((t (:inherit font-lock-type-face))) 2066 "Face for HTML tag names." 2067 :group 'markdown-faces) 2068 2069 (defface markdown-html-tag-delimiter-face 2070 '((t (:inherit markdown-markup-face))) 2071 "Face for HTML tag delimiters." 2072 :group 'markdown-faces) 2073 2074 (defface markdown-html-attr-name-face 2075 '((t (:inherit font-lock-variable-name-face))) 2076 "Face for HTML attribute names." 2077 :group 'markdown-faces) 2078 2079 (defface markdown-html-attr-value-face 2080 '((t (:inherit font-lock-string-face))) 2081 "Face for HTML attribute values." 2082 :group 'markdown-faces) 2083 2084 (defface markdown-html-entity-face 2085 '((t (:inherit font-lock-variable-name-face))) 2086 "Face for HTML entities." 2087 :group 'markdown-faces) 2088 2089 (defface markdown-highlighting-face 2090 '((t (:background "yellow" :foreground "black"))) 2091 "Face for highlighting." 2092 :group 'markdown-faces) 2093 2094 (defcustom markdown-header-scaling nil 2095 "Whether to use variable-height faces for headers. 2096 When non-nil, `markdown-header-face' will inherit from 2097 `variable-pitch' and the scaling values in 2098 `markdown-header-scaling-values' will be applied to 2099 headers of levels one through six respectively." 2100 :type 'boolean 2101 :initialize #'custom-initialize-default 2102 :set (lambda (symbol value) 2103 (set-default symbol value) 2104 (markdown-update-header-faces value)) 2105 :group 'markdown-faces 2106 :package-version '(markdown-mode . "2.2")) 2107 2108 (defcustom markdown-header-scaling-values 2109 '(2.0 1.7 1.4 1.1 1.0 1.0) 2110 "List of scaling values for headers of level one through six. 2111 Used when `markdown-header-scaling' is non-nil." 2112 :type '(repeat float) 2113 :initialize #'custom-initialize-default 2114 :set (lambda (symbol value) 2115 (set-default symbol value) 2116 (markdown-update-header-faces markdown-header-scaling value))) 2117 2118 (defmacro markdown--dotimes-when-compile (i-n body) 2119 (declare (indent 1) (debug ((symbolp form) form))) 2120 (let ((var (car i-n)) 2121 (n (cadr i-n)) 2122 (code ())) 2123 (dotimes (i (eval n t)) 2124 (push (eval body `((,var . ,i))) code)) 2125 `(progn ,@(nreverse code)))) 2126 2127 (defface markdown-header-face 2128 `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) 2129 font-lock-function-name-face) 2130 :weight bold))) 2131 "Base face for headers.") 2132 2133 (markdown--dotimes-when-compile (num 6) 2134 (let* ((num1 (1+ num)) 2135 (face-name (intern (format "markdown-header-face-%s" num1)))) 2136 `(defface ,face-name 2137 (,'\` ((t (:inherit markdown-header-face 2138 :height 2139 (,'\, (if markdown-header-scaling 2140 (float (nth ,num markdown-header-scaling-values)) 2141 1.0)))))) 2142 (format "Face for level %s headers. 2143 You probably don't want to customize this face directly. Instead 2144 you can customize the base face `markdown-header-face' or the 2145 variable-height variable `markdown-header-scaling'." ,num1)))) 2146 2147 (defun markdown-update-header-faces (&optional scaling scaling-values) 2148 "Update header faces, depending on if header SCALING is desired. 2149 If so, use given list of SCALING-VALUES relative to the baseline 2150 size of `markdown-header-face'." 2151 (dotimes (num 6) 2152 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) 2153 (scale (cond ((not scaling) 1.0) 2154 (scaling-values (float (nth num scaling-values))) 2155 (t (float (nth num markdown-header-scaling-values)))))) 2156 (unless (get face-name 'saved-face) ; Don't update customized faces 2157 (set-face-attribute face-name nil :height scale))))) 2158 2159 (defun markdown-syntactic-face (state) 2160 "Return font-lock face for characters with given STATE. 2161 See `font-lock-syntactic-face-function' for details." 2162 (let ((in-comment (nth 4 state))) 2163 (cond 2164 (in-comment 'markdown-comment-face) 2165 (t nil)))) 2166 2167 (defcustom markdown-list-item-bullets 2168 '("●" "◎" "○" "◆" "◇" "►" "•") 2169 "List of bullets to use for unordered lists. 2170 It can contain any number of symbols, which will be repeated. 2171 Depending on your font, some reasonable choices are: 2172 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." 2173 :group 'markdown 2174 :type '(repeat (string :tag "Bullet character")) 2175 :package-version '(markdown-mode . "2.3")) 2176 2177 (defun markdown--footnote-marker-properties () 2178 "Return a font-lock facespec expression for footnote marker text." 2179 `(face markdown-footnote-marker-face 2180 ,@(when markdown-hide-markup 2181 `(display ,markdown-footnote-display)))) 2182 2183 (defun markdown--pandoc-inline-footnote-properties () 2184 "Return a font-lock facespec expression for Pandoc inline footnote text." 2185 `(face markdown-footnote-text-face 2186 ,@(when markdown-hide-markup 2187 `(display ,markdown-footnote-display)))) 2188 2189 (defvar markdown-mode-font-lock-keywords 2190 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) 2191 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) 2192 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) 2193 (2 'markdown-markup-face) 2194 (3 'markdown-metadata-value-face))) 2195 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) 2196 (2 markdown-markup-properties nil t) 2197 (3 markdown-language-keyword-properties nil t) 2198 (4 markdown-language-info-properties nil t) 2199 (5 markdown-markup-properties nil t))) 2200 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) 2201 (markdown-fontify-gfm-code-blocks) 2202 (markdown-fontify-tables) 2203 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) 2204 (2 markdown-markup-properties nil t) 2205 (3 markdown-language-keyword-properties nil t) 2206 (4 markdown-language-info-properties nil t) 2207 (5 markdown-markup-properties nil t))) 2208 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) 2209 (markdown-fontify-fenced-code-blocks) 2210 (markdown-match-pre-blocks . ((0 'markdown-pre-face))) 2211 (markdown-fontify-headings) 2212 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) 2213 (2 'markdown-markup-face) 2214 (3 'markdown-metadata-value-face))) 2215 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) 2216 (2 'markdown-markup-face) 2217 (3 'markdown-metadata-value-face))) 2218 (markdown-fontify-hrs) 2219 (markdown-match-code . ((1 markdown-markup-properties prepend) 2220 (2 'markdown-inline-code-face prepend) 2221 (3 markdown-markup-properties prepend))) 2222 (,markdown-regex-kbd . ((1 markdown-markup-properties) 2223 (2 'markdown-inline-code-face) 2224 (3 markdown-markup-properties))) 2225 (markdown-fontify-angle-uris) 2226 (,markdown-regex-email . 'markdown-plain-url-face) 2227 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) 2228 (2 'markdown-html-tag-name-face t) 2229 (3 'markdown-html-tag-delimiter-face t) 2230 ;; Anchored matcher for HTML tag attributes 2231 (,markdown-regex-html-attr 2232 ;; Before searching, move past tag 2233 ;; name; set limit at tag close. 2234 (progn 2235 (goto-char (match-end 2)) (match-end 3)) 2236 nil 2237 . ((1 'markdown-html-attr-name-face) 2238 (3 'markdown-html-tag-delimiter-face nil t) 2239 (4 'markdown-html-attr-value-face nil t))))) 2240 (,markdown-regex-html-entity . 'markdown-html-entity-face) 2241 (markdown-fontify-list-items) 2242 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ 2243 (2 (markdown--footnote-marker-properties)) ; label 2244 (3 markdown-markup-properties))) ; ] 2245 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ 2246 (2 markdown-markup-properties) ; [ 2247 (3 (markdown--pandoc-inline-footnote-properties)) ; text 2248 (4 markdown-markup-properties))) ; ] 2249 (markdown-match-includes . ((1 markdown-markup-properties) 2250 (2 markdown-markup-properties nil t) 2251 (3 markdown-include-title-properties nil t) 2252 (4 markdown-markup-properties nil t) 2253 (5 markdown-markup-properties) 2254 (6 'markdown-url-face) 2255 (7 markdown-markup-properties))) 2256 (markdown-fontify-inline-links) 2257 (markdown-fontify-reference-links) 2258 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ 2259 (2 'markdown-reference-face) ; label 2260 (3 'markdown-markup-face) ; ] 2261 (4 'markdown-markup-face) ; : 2262 (5 'markdown-url-face) ; url 2263 (6 'markdown-link-title-face))) ; "title" (optional) 2264 (markdown-fontify-plain-uris) 2265 ;; Math mode $..$ 2266 (markdown-match-math-single . ((1 'markdown-markup-face prepend) 2267 (2 'markdown-math-face append) 2268 (3 'markdown-markup-face prepend))) 2269 ;; Math mode $$..$$ 2270 (markdown-match-math-double . ((1 'markdown-markup-face prepend) 2271 (2 'markdown-math-face append) 2272 (3 'markdown-markup-face prepend))) 2273 ;; Math mode \[..\] and \\[..\\] 2274 (markdown-match-math-display . ((1 'markdown-markup-face prepend) 2275 (3 'markdown-math-face append) 2276 (4 'markdown-markup-face prepend))) 2277 (markdown-match-bold . ((1 markdown-markup-properties prepend) 2278 (2 'markdown-bold-face append) 2279 (3 markdown-markup-properties prepend))) 2280 (markdown-match-italic . ((1 markdown-markup-properties prepend) 2281 (2 'markdown-italic-face append) 2282 (3 markdown-markup-properties prepend))) 2283 (,markdown-regex-strike-through . ((3 markdown-markup-properties) 2284 (4 'markdown-strike-through-face) 2285 (5 markdown-markup-properties))) 2286 (markdown--match-highlighting . ((3 markdown-markup-properties) 2287 (4 'markdown-highlighting-face) 2288 (5 markdown-markup-properties))) 2289 (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) 2290 (markdown-match-escape . ((1 markdown-markup-properties prepend))) 2291 (markdown-fontify-sub-superscripts) 2292 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) 2293 (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) 2294 (markdown-fontify-blockquotes) 2295 (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) 2296 "Syntax highlighting for Markdown files.") 2297 2298 ;; Footnotes 2299 (defvar-local markdown-footnote-counter 0 2300 "Counter for footnote numbers.") 2301 2302 (defconst markdown-footnote-chars 2303 "[[:alnum:]-]" 2304 "Regular expression matching any character for a footnote identifier.") 2305 2306 (defconst markdown-regex-footnote-definition 2307 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") 2308 "Regular expression matching a footnote definition, capturing the label.") 2309 2310 2311 ;;; Compatibility ============================================================= 2312 2313 (defun markdown--pandoc-reference-p () 2314 (let ((bounds (bounds-of-thing-at-point 'word))) 2315 (when (and bounds (char-before (car bounds))) 2316 (= (char-before (car bounds)) ?@)))) 2317 2318 (defun markdown-flyspell-check-word-p () 2319 "Return t if `flyspell' should check word just before point. 2320 Used for `flyspell-generic-check-word-predicate'." 2321 (save-excursion 2322 (goto-char (1- (point))) 2323 ;; https://github.com/jrblevin/markdown-mode/issues/560 2324 ;; enable spell check YAML meta data 2325 (if (or (and (markdown-code-block-at-point-p) 2326 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) 2327 (markdown-inline-code-at-point-p) 2328 (markdown-in-comment-p) 2329 (markdown--face-p (point) '(markdown-reference-face 2330 markdown-markup-face 2331 markdown-plain-url-face 2332 markdown-inline-code-face 2333 markdown-url-face)) 2334 (markdown--pandoc-reference-p)) 2335 (prog1 nil 2336 ;; If flyspell overlay is put, then remove it 2337 (let ((bounds (bounds-of-thing-at-point 'word))) 2338 (when bounds 2339 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) 2340 when (overlay-get ov 'flyspell-overlay) 2341 do 2342 (delete-overlay ov))))) 2343 t))) 2344 2345 2346 ;;; Markdown Parsing Functions ================================================ 2347 2348 (defun markdown-cur-line-blank-p () 2349 "Return t if the current line is blank and nil otherwise." 2350 (save-excursion 2351 (beginning-of-line) 2352 (looking-at-p markdown-regex-blank-line))) 2353 2354 (defun markdown-prev-line-blank () 2355 "Return t if the previous line is blank and nil otherwise. 2356 If we are at the first line, then consider the previous line to be blank." 2357 (or (= (line-beginning-position) (point-min)) 2358 (save-excursion 2359 (forward-line -1) 2360 (looking-at markdown-regex-blank-line)))) 2361 2362 (defun markdown-prev-line-blank-p () 2363 "Like `markdown-prev-line-blank', but preserve `match-data'." 2364 (save-match-data (markdown-prev-line-blank))) 2365 2366 (defun markdown-next-line-blank-p () 2367 "Return t if the next line is blank and nil otherwise. 2368 If we are at the last line, then consider the next line to be blank." 2369 (or (= (line-end-position) (point-max)) 2370 (save-excursion 2371 (forward-line 1) 2372 (markdown-cur-line-blank-p)))) 2373 2374 (defun markdown-prev-line-indent () 2375 "Return the number of leading whitespace characters in the previous line. 2376 Return 0 if the current line is the first line in the buffer." 2377 (save-excursion 2378 (if (= (line-beginning-position) (point-min)) 2379 0 2380 (forward-line -1) 2381 (current-indentation)))) 2382 2383 (defun markdown-next-line-indent () 2384 "Return the number of leading whitespace characters in the next line. 2385 Return 0 if line is the last line in the buffer." 2386 (save-excursion 2387 (if (= (line-end-position) (point-max)) 2388 0 2389 (forward-line 1) 2390 (current-indentation)))) 2391 2392 (defun markdown-new-baseline () 2393 "Determine if the current line begins a new baseline level. 2394 Assume point is positioned at beginning of line." 2395 (or (looking-at markdown-regex-header) 2396 (looking-at markdown-regex-hr) 2397 (and (= (current-indentation) 0) 2398 (not (looking-at markdown-regex-list)) 2399 (markdown-prev-line-blank)))) 2400 2401 (defun markdown-search-backward-baseline () 2402 "Search backward baseline point with no indentation and not a list item." 2403 (end-of-line) 2404 (let (stop) 2405 (while (not (or stop (bobp))) 2406 (re-search-backward markdown-regex-block-separator-noindent nil t) 2407 (when (match-end 2) 2408 (goto-char (match-end 2)) 2409 (cond 2410 ((markdown-new-baseline) 2411 (setq stop t)) 2412 ((looking-at-p markdown-regex-list) 2413 (setq stop nil)) 2414 (t (setq stop t))))))) 2415 2416 (defun markdown-update-list-levels (marker indent levels) 2417 "Update list levels given list MARKER, block INDENT, and current LEVELS. 2418 Here, MARKER is a string representing the type of list, INDENT is an integer 2419 giving the indentation, in spaces, of the current block, and LEVELS is a 2420 list of the indentation levels of parent list items. When LEVELS is nil, 2421 it means we are at baseline (not inside of a nested list)." 2422 (cond 2423 ;; New list item at baseline. 2424 ((and marker (null levels)) 2425 (setq levels (list indent))) 2426 ;; List item with greater indentation (four or more spaces). 2427 ;; Increase list level. 2428 ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) 2429 (setq levels (cons indent levels))) 2430 ;; List item with greater or equal indentation (less than four spaces). 2431 ;; Do not increase list level. 2432 ((and marker (>= indent (car levels))) 2433 levels) 2434 ;; Lesser indentation level. 2435 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser 2436 ;; indentation could move back more than one list level). Note 2437 ;; that this block need not be the beginning of list item. 2438 ((< indent (car levels)) 2439 (while (and (> (length levels) 1) 2440 (< indent (+ (cadr levels) markdown-list-indent-width))) 2441 (setq levels (cdr levels))) 2442 levels) 2443 ;; Otherwise, do nothing. 2444 (t levels))) 2445 2446 (defun markdown-calculate-list-levels () 2447 "Calculate list levels at point. 2448 Return a list of the form (n1 n2 n3 ...) where n1 is the 2449 indentation of the deepest nested list item in the branch of 2450 the list at the point, n2 is the indentation of the parent 2451 list item, and so on. The depth of the list item is therefore 2452 the length of the returned list. If the point is not at or 2453 immediately after a list item, return nil." 2454 (save-excursion 2455 (let ((first (point)) levels indent pre-regexp) 2456 ;; Find a baseline point with zero list indentation 2457 (markdown-search-backward-baseline) 2458 ;; Search for all list items between baseline and LOC 2459 (while (and (< (point) first) 2460 (re-search-forward markdown-regex-list first t)) 2461 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) 2462 (beginning-of-line) 2463 (cond 2464 ;; Make sure this is not a header or hr 2465 ((markdown-new-baseline) (setq levels nil)) 2466 ;; Make sure this is not a line from a pre block 2467 ((looking-at-p pre-regexp)) 2468 ;; If not, then update levels 2469 (t 2470 (setq indent (current-indentation)) 2471 (setq levels (markdown-update-list-levels (match-string 2) 2472 indent levels)))) 2473 (end-of-line)) 2474 levels))) 2475 2476 (defun markdown-prev-list-item (level) 2477 "Search backward from point for a list item with indentation LEVEL. 2478 Set point to the beginning of the item, and return point, or nil 2479 upon failure." 2480 (let (bounds indent prev) 2481 (setq prev (point)) 2482 (forward-line -1) 2483 (setq indent (current-indentation)) 2484 (while 2485 (cond 2486 ;; List item 2487 ((and (looking-at-p markdown-regex-list) 2488 (setq bounds (markdown-cur-list-item-bounds))) 2489 (cond 2490 ;; Stop and return point at item of equal indentation 2491 ((= (nth 3 bounds) level) 2492 (setq prev (point)) 2493 nil) 2494 ;; Stop and return nil at item with lesser indentation 2495 ((< (nth 3 bounds) level) 2496 (setq prev nil) 2497 nil) 2498 ;; Stop at beginning of buffer 2499 ((bobp) (setq prev nil)) 2500 ;; Continue at item with greater indentation 2501 ((> (nth 3 bounds) level) t))) 2502 ;; Stop at beginning of buffer 2503 ((bobp) (setq prev nil)) 2504 ;; Continue if current line is blank 2505 ((markdown-cur-line-blank-p) t) 2506 ;; Continue while indentation is the same or greater 2507 ((>= indent level) t) 2508 ;; Stop if current indentation is less than list item 2509 ;; and the next is blank 2510 ((and (< indent level) 2511 (markdown-next-line-blank-p)) 2512 (setq prev nil)) 2513 ;; Stop at a header 2514 ((looking-at-p markdown-regex-header) (setq prev nil)) 2515 ;; Stop at a horizontal rule 2516 ((looking-at-p markdown-regex-hr) (setq prev nil)) 2517 ;; Otherwise, continue. 2518 (t t)) 2519 (forward-line -1) 2520 (setq indent (current-indentation))) 2521 prev)) 2522 2523 (defun markdown-next-list-item (level) 2524 "Search forward from point for the next list item with indentation LEVEL. 2525 Set point to the beginning of the item, and return point, or nil 2526 upon failure." 2527 (let (bounds indent next) 2528 (setq next (point)) 2529 (if (looking-at markdown-regex-header-setext) 2530 (goto-char (match-end 0))) 2531 (forward-line) 2532 (setq indent (current-indentation)) 2533 (while 2534 (cond 2535 ;; Stop at end of the buffer. 2536 ((eobp) nil) 2537 ;; Continue if the current line is blank 2538 ((markdown-cur-line-blank-p) t) 2539 ;; List item 2540 ((and (looking-at-p markdown-regex-list) 2541 (setq bounds (markdown-cur-list-item-bounds))) 2542 (cond 2543 ;; Continue at item with greater indentation 2544 ((> (nth 3 bounds) level) t) 2545 ;; Stop and return point at item of equal indentation 2546 ((= (nth 3 bounds) level) 2547 (setq next (point)) 2548 nil) 2549 ;; Stop and return nil at item with lesser indentation 2550 ((< (nth 3 bounds) level) 2551 (setq next nil) 2552 nil))) 2553 ;; Continue while indentation is the same or greater 2554 ((>= indent level) t) 2555 ;; Stop if current indentation is less than list item 2556 ;; and the previous line was blank. 2557 ((and (< indent level) 2558 (markdown-prev-line-blank-p)) 2559 (setq next nil)) 2560 ;; Stop at a header 2561 ((looking-at-p markdown-regex-header) (setq next nil)) 2562 ;; Stop at a horizontal rule 2563 ((looking-at-p markdown-regex-hr) (setq next nil)) 2564 ;; Otherwise, continue. 2565 (t t)) 2566 (forward-line) 2567 (setq indent (current-indentation))) 2568 next)) 2569 2570 (defun markdown-cur-list-item-end (level) 2571 "Move to end of list item with pre-marker indentation LEVEL. 2572 Return the point at the end when a list item was found at the 2573 original point. If the point is not in a list item, do nothing." 2574 (let (indent) 2575 (forward-line) 2576 (setq indent (current-indentation)) 2577 (while 2578 (cond 2579 ;; Stop at end of the buffer. 2580 ((eobp) nil) 2581 ;; Continue while indentation is the same or greater 2582 ((>= indent level) t) 2583 ;; Continue if the current line is blank 2584 ((looking-at markdown-regex-blank-line) t) 2585 ;; Stop if current indentation is less than list item 2586 ;; and the previous line was blank. 2587 ((and (< indent level) 2588 (markdown-prev-line-blank)) 2589 nil) 2590 ;; Stop at a new list items of the same or lesser 2591 ;; indentation, headings, and horizontal rules. 2592 ((looking-at (concat "\\(?:" markdown-regex-list 2593 "\\|" markdown-regex-header 2594 "\\|" markdown-regex-hr "\\)")) 2595 nil) 2596 ;; Otherwise, continue. 2597 (t t)) 2598 (forward-line) 2599 (setq indent (current-indentation))) 2600 ;; Don't skip over whitespace for empty list items (marker and 2601 ;; whitespace only), just move to end of whitespace. 2602 (if (save-excursion 2603 (beginning-of-line) 2604 (looking-at (concat markdown-regex-list "[ \t]*$"))) 2605 (goto-char (match-end 3)) 2606 (skip-chars-backward " \t\n")) 2607 (end-of-line) 2608 (point))) 2609 2610 (defun markdown-cur-list-item-bounds () 2611 "Return bounds for list item at point. 2612 Return a list of the following form: 2613 2614 (begin end indent nonlist-indent marker checkbox match) 2615 2616 The named components are: 2617 2618 - begin: Position of beginning of list item, including leading indentation. 2619 - end: Position of the end of the list item, including list item text. 2620 - indent: Number of characters of indentation before list marker (an integer). 2621 - nonlist-indent: Number characters of indentation, list 2622 marker, and whitespace following list marker (an integer). 2623 - marker: String containing the list marker and following whitespace 2624 (e.g., \"- \" or \"* \"). 2625 - checkbox: String containing the GFM checkbox portion, if any, 2626 including any trailing whitespace before the text 2627 begins (e.g., \"[x] \"). 2628 - match: match data for markdown-regex-list 2629 2630 As an example, for the following unordered list item 2631 2632 - item 2633 2634 the returned list would be 2635 2636 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) 2637 2638 If the point is not inside a list item, return nil." 2639 (car (get-text-property (line-beginning-position) 'markdown-list-item))) 2640 2641 (defun markdown-list-item-at-point-p () 2642 "Return t if there is a list item at the point and nil otherwise." 2643 (save-match-data (markdown-cur-list-item-bounds))) 2644 2645 (defun markdown-prev-list-item-bounds () 2646 "Return bounds of previous item in the same list of any level. 2647 The return value has the same form as that of 2648 `markdown-cur-list-item-bounds'." 2649 (save-excursion 2650 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2651 (beginning-of-list (save-excursion (markdown-beginning-of-list))) 2652 stop) 2653 (when cur-bounds 2654 (goto-char (nth 0 cur-bounds)) 2655 (while (and (not stop) (not (bobp)) 2656 (re-search-backward markdown-regex-list 2657 beginning-of-list t)) 2658 (unless (or (looking-at markdown-regex-hr) 2659 (markdown-code-block-at-point-p)) 2660 (setq stop (point)))) 2661 (markdown-cur-list-item-bounds))))) 2662 2663 (defun markdown-next-list-item-bounds () 2664 "Return bounds of next item in the same list of any level. 2665 The return value has the same form as that of 2666 `markdown-cur-list-item-bounds'." 2667 (save-excursion 2668 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2669 (end-of-list (save-excursion (markdown-end-of-list))) 2670 stop) 2671 (when cur-bounds 2672 (goto-char (nth 0 cur-bounds)) 2673 (end-of-line) 2674 (while (and (not stop) (not (eobp)) 2675 (re-search-forward markdown-regex-list 2676 end-of-list t)) 2677 (unless (or (looking-at markdown-regex-hr) 2678 (markdown-code-block-at-point-p)) 2679 (setq stop (point)))) 2680 (when stop 2681 (markdown-cur-list-item-bounds)))))) 2682 2683 (defun markdown-beginning-of-list () 2684 "Move point to beginning of list at point, if any." 2685 (interactive) 2686 (let ((orig-point (point)) 2687 (list-begin (save-excursion 2688 (markdown-search-backward-baseline) 2689 ;; Stop at next list item, regardless of the indentation. 2690 (markdown-next-list-item (point-max)) 2691 (when (looking-at markdown-regex-list) 2692 (point))))) 2693 (when (and list-begin (<= list-begin orig-point)) 2694 (goto-char list-begin)))) 2695 2696 (defun markdown-end-of-list () 2697 "Move point to end of list at point, if any." 2698 (interactive) 2699 (let ((start (point)) 2700 (end (save-excursion 2701 (when (markdown-beginning-of-list) 2702 ;; Items can't have nonlist-indent <= 1, so this 2703 ;; moves past all list items. 2704 (markdown-next-list-item 1) 2705 (skip-syntax-backward "-") 2706 (unless (eobp) (forward-char 1)) 2707 (point))))) 2708 (when (and end (>= end start)) 2709 (goto-char end)))) 2710 2711 (defun markdown-up-list () 2712 "Move point to beginning of parent list item." 2713 (interactive) 2714 (let ((cur-bounds (markdown-cur-list-item-bounds))) 2715 (when cur-bounds 2716 (markdown-prev-list-item (1- (nth 3 cur-bounds))) 2717 (let ((up-bounds (markdown-cur-list-item-bounds))) 2718 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) 2719 (point)))))) 2720 2721 (defun markdown-bounds-of-thing-at-point (thing) 2722 "Call `bounds-of-thing-at-point' for THING with slight modifications. 2723 Does not include trailing newlines when THING is \\='line. Handles the 2724 end of buffer case by setting both endpoints equal to the value of 2725 `point-max', since an empty region will trigger empty markup insertion. 2726 Return bounds of form (beg . end) if THING is found, or nil otherwise." 2727 (let* ((bounds (bounds-of-thing-at-point thing)) 2728 (a (car bounds)) 2729 (b (cdr bounds))) 2730 (when bounds 2731 (when (eq thing 'line) 2732 (cond ((and (eobp) (markdown-cur-line-blank-p)) 2733 (setq a b)) 2734 ((char-equal (char-before b) ?\^J) 2735 (setq b (1- b))))) 2736 (cons a b)))) 2737 2738 (defun markdown-reference-definition (reference) 2739 "Find out whether Markdown REFERENCE is defined. 2740 REFERENCE should not include the square brackets. 2741 When REFERENCE is defined, return a list of the form (text start end) 2742 containing the definition text itself followed by the start and end 2743 locations of the text. Otherwise, return nil. 2744 Leave match data for `markdown-regex-reference-definition' 2745 intact additional processing." 2746 (let ((reference (downcase reference))) 2747 (save-excursion 2748 (goto-char (point-min)) 2749 (catch 'found 2750 (while (re-search-forward markdown-regex-reference-definition nil t) 2751 (when (string= reference (downcase (match-string-no-properties 2))) 2752 (throw 'found 2753 (list (match-string-no-properties 5) 2754 (match-beginning 5) (match-end 5))))))))) 2755 2756 (defun markdown-get-defined-references () 2757 "Return all defined reference labels and their line numbers. 2758 They does not include square brackets)." 2759 (save-excursion 2760 (goto-char (point-min)) 2761 (let (refs) 2762 (while (re-search-forward markdown-regex-reference-definition nil t) 2763 (let ((target (match-string-no-properties 2))) 2764 (cl-pushnew 2765 (cons (downcase target) 2766 (markdown-line-number-at-pos (match-beginning 2))) 2767 refs :test #'equal :key #'car))) 2768 (reverse refs)))) 2769 2770 (defun markdown-get-used-uris () 2771 "Return a list of all used URIs in the buffer." 2772 (save-excursion 2773 (goto-char (point-min)) 2774 (let (uris) 2775 (while (re-search-forward 2776 (concat "\\(?:" markdown-regex-link-inline 2777 "\\|" markdown-regex-angle-uri 2778 "\\|" markdown-regex-uri 2779 "\\|" markdown-regex-email 2780 "\\)") 2781 nil t) 2782 (unless (or (markdown-inline-code-at-point-p) 2783 (markdown-code-block-at-point-p)) 2784 (cl-pushnew (or (match-string-no-properties 6) 2785 (match-string-no-properties 10) 2786 (match-string-no-properties 12) 2787 (match-string-no-properties 13)) 2788 uris :test #'equal))) 2789 (reverse uris)))) 2790 2791 (defun markdown-inline-code-at-pos (pos) 2792 "Return non-nil if there is an inline code fragment at POS. 2793 Return nil otherwise. Set match data according to 2794 `markdown-match-code' upon success. 2795 This function searches the block for a code fragment that 2796 contains the point using `markdown-match-code'. We do this 2797 because `thing-at-point-looking-at' does not work reliably with 2798 `markdown-regex-code'. 2799 2800 The match data is set as follows: 2801 Group 1 matches the opening backquotes. 2802 Group 2 matches the code fragment itself, without backquotes. 2803 Group 3 matches the closing backquotes." 2804 (save-excursion 2805 (goto-char pos) 2806 (let ((old-point (point)) 2807 (end-of-block (progn (markdown-end-of-text-block) (point))) 2808 found) 2809 (markdown-beginning-of-text-block) 2810 (while (and (markdown-match-code end-of-block) 2811 (setq found t) 2812 (< (match-end 0) old-point))) 2813 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) 2814 (and found ; matched something 2815 (<= (match-beginning match-group) old-point) ; match contains old-point 2816 (> (match-end 0) old-point)))))) 2817 2818 (defun markdown-inline-code-at-pos-p (pos) 2819 "Return non-nil if there is an inline code fragment at POS. 2820 Like `markdown-inline-code-at-pos`, but preserves match data." 2821 (save-match-data (markdown-inline-code-at-pos pos))) 2822 2823 (defun markdown-inline-code-at-point () 2824 "Return non-nil if the point is at an inline code fragment. 2825 See `markdown-inline-code-at-pos' for details." 2826 (markdown-inline-code-at-pos (point))) 2827 2828 (defun markdown-inline-code-at-point-p (&optional pos) 2829 "Return non-nil if there is inline code at the POS. 2830 This is a predicate function counterpart to 2831 `markdown-inline-code-at-point' which does not modify the match 2832 data. See `markdown-code-block-at-point-p' for code blocks." 2833 (save-match-data (markdown-inline-code-at-pos (or pos (point))))) 2834 2835 (defun markdown-code-block-at-pos (pos) 2836 "Return match data list if there is a code block at POS. 2837 Uses text properties at the beginning of the line position. 2838 This includes pre blocks, tilde-fenced code blocks, and GFM 2839 quoted code blocks. Return nil otherwise." 2840 (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) 2841 (or (get-text-property bol 'markdown-pre) 2842 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) 2843 (second (cl-second bounds))) 2844 (if second 2845 ;; chunks are right open 2846 (when (< pos second) 2847 bounds) 2848 bounds))))) 2849 2850 ;; Function was renamed to emphasize that it does not modify match-data. 2851 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) 2852 2853 (defun markdown-code-block-at-point-p (&optional pos) 2854 "Return non-nil if there is a code block at the POS. 2855 This includes pre blocks, tilde-fenced code blocks, and GFM 2856 quoted code blocks. This function does not modify the match 2857 data. See `markdown-inline-code-at-point-p' for inline code." 2858 (save-match-data (markdown-code-block-at-pos (or pos (point))))) 2859 2860 (defun markdown-heading-at-point (&optional pos) 2861 "Return non-nil if there is a heading at the POS. 2862 Set match data for `markdown-regex-header'." 2863 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) 2864 (when match-data 2865 (set-match-data match-data) 2866 t))) 2867 2868 (defun markdown-pipe-at-bol-p () 2869 "Return non-nil if the line begins with a pipe symbol. 2870 This may be useful for tables and Pandoc's line_blocks extension." 2871 (char-equal (char-after (line-beginning-position)) ?|)) 2872 2873 2874 ;;; Markdown Font Lock Matching Functions ===================================== 2875 2876 (defun markdown-range-property-any (begin end prop prop-values) 2877 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. 2878 Also returns t if PROP is a list containing one of the PROP-VALUES. 2879 Return nil otherwise." 2880 (let (props) 2881 (catch 'found 2882 (dolist (loc (number-sequence begin end)) 2883 (when (setq props (get-text-property loc prop)) 2884 (cond ((listp props) 2885 ;; props is a list, check for membership 2886 (dolist (val prop-values) 2887 (when (memq val props) (throw 'found loc)))) 2888 (t 2889 ;; props is a scalar, check for equality 2890 (dolist (val prop-values) 2891 (when (eq val props) (throw 'found loc)))))))))) 2892 2893 (defun markdown-range-properties-exist (begin end props) 2894 (cl-loop 2895 for loc in (number-sequence begin end) 2896 with result = nil 2897 while (not 2898 (setq result 2899 (cl-some (lambda (prop) (get-text-property loc prop)) props))) 2900 finally return result)) 2901 2902 (defun markdown-match-inline-generic (regex last &optional faceless) 2903 "Match inline REGEX from the point to LAST. 2904 When FACELESS is non-nil, do not return matches where faces have been applied." 2905 (when (re-search-forward regex last t) 2906 (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) 2907 (face (and faceless (text-property-not-all 2908 (match-beginning 0) (match-end 0) 'face nil)))) 2909 (cond 2910 ;; In code block: move past it and recursively search again 2911 (bounds 2912 (when (< (goto-char (cl-second bounds)) last) 2913 (markdown-match-inline-generic regex last faceless))) 2914 ;; When faces are found in the match range, skip over the match and 2915 ;; recursively search again. 2916 (face 2917 (when (< (goto-char (match-end 0)) last) 2918 (markdown-match-inline-generic regex last faceless))) 2919 ;; Keep match data and return t when in bounds. 2920 (t 2921 (<= (match-end 0) last)))))) 2922 2923 (defun markdown-match-code (last) 2924 "Match inline code fragments from point to LAST." 2925 (unless (bobp) 2926 (backward-char 1)) 2927 (when (markdown-search-until-condition 2928 (lambda () 2929 (and 2930 ;; Advance point in case of failure, but without exceeding last. 2931 (goto-char (min (1+ (match-beginning 1)) last)) 2932 (not (markdown-in-comment-p (match-beginning 1))) 2933 (not (markdown-in-comment-p (match-end 1))) 2934 (not (markdown-code-block-at-pos (match-beginning 1))))) 2935 markdown-regex-code last t) 2936 (set-match-data (list (match-beginning 1) (match-end 1) 2937 (match-beginning 2) (match-end 2) 2938 (match-beginning 3) (match-end 3) 2939 (match-beginning 4) (match-end 4))) 2940 (goto-char (min (1+ (match-end 0)) last (point-max))) 2941 t)) 2942 2943 (defun markdown--gfm-markup-underscore-p (begin end) 2944 (let ((is-underscore (eql (char-after begin) ?_))) 2945 (if (not is-underscore) 2946 t 2947 (save-excursion 2948 (save-match-data 2949 (goto-char begin) 2950 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) 2951 (progn 2952 (goto-char end) 2953 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) 2954 2955 (defun markdown-match-bold (last) 2956 "Match inline bold from the point to LAST." 2957 (when (markdown-match-inline-generic markdown-regex-bold last) 2958 (let ((is-gfm (derived-mode-p 'gfm-mode)) 2959 (begin (match-beginning 2)) 2960 (end (match-end 2))) 2961 (if (or (markdown-inline-code-at-pos-p begin) 2962 (markdown-inline-code-at-pos-p end) 2963 (markdown-in-comment-p) 2964 (markdown-range-property-any 2965 begin begin 'face '(markdown-url-face 2966 markdown-plain-url-face)) 2967 (markdown-range-property-any 2968 begin end 'face '(markdown-hr-face 2969 markdown-math-face)) 2970 (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) 2971 (progn (goto-char (min (1+ begin) last)) 2972 (when (< (point) last) 2973 (markdown-match-bold last))) 2974 (set-match-data (list (match-beginning 2) (match-end 2) 2975 (match-beginning 3) (match-end 3) 2976 (match-beginning 4) (match-end 4) 2977 (match-beginning 5) (match-end 5))) 2978 t)))) 2979 2980 (defun markdown-match-italic (last) 2981 "Match inline italics from the point to LAST." 2982 (let* ((is-gfm (derived-mode-p 'gfm-mode)) 2983 (regex (if is-gfm 2984 markdown-regex-gfm-italic 2985 markdown-regex-italic))) 2986 (when (and (markdown-match-inline-generic regex last) 2987 (not (markdown--face-p 2988 (match-beginning 1) 2989 '(markdown-html-attr-name-face markdown-html-attr-value-face)))) 2990 (let ((begin (match-beginning 1)) 2991 (end (match-end 1)) 2992 (close-end (match-end 4))) 2993 (if (or (eql (char-before begin) (char-after begin)) 2994 (markdown-inline-code-at-pos-p begin) 2995 (markdown-inline-code-at-pos-p (1- end)) 2996 (markdown-in-comment-p) 2997 (markdown-range-property-any 2998 begin begin 'face '(markdown-url-face 2999 markdown-plain-url-face 3000 markdown-markup-face)) 3001 (markdown-range-property-any 3002 begin end 'face '(markdown-bold-face 3003 markdown-list-face 3004 markdown-hr-face 3005 markdown-math-face)) 3006 (and is-gfm 3007 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case 3008 (not (markdown--gfm-markup-underscore-p begin close-end))))) 3009 (progn (goto-char (min (1+ begin) last)) 3010 (when (< (point) last) 3011 (markdown-match-italic last))) 3012 (set-match-data (list (match-beginning 1) (match-end 1) 3013 (match-beginning 2) (match-end 2) 3014 (match-beginning 3) (match-end 3) 3015 (match-beginning 4) (match-end 4))) 3016 t))))) 3017 3018 (defun markdown--match-highlighting (last) 3019 (when markdown-enable-highlighting-syntax 3020 (re-search-forward markdown-regex-highlighting last t))) 3021 3022 (defun markdown-match-escape (last) 3023 "Match escape characters (backslashes) from point to LAST. 3024 Backlashes only count as escape characters outside of literal 3025 regions (e.g. code blocks). See `markdown-literal-faces'." 3026 (catch 'found 3027 (while (search-forward-regexp markdown-regex-escape last t) 3028 (let* ((face (get-text-property (match-beginning 1) 'face)) 3029 (face-list (if (listp face) face (list face)))) 3030 ;; Ignore any backslashes with a literal face. 3031 (unless (cl-intersection face-list markdown-literal-faces) 3032 (throw 'found t)))))) 3033 3034 (defun markdown-match-math-generic (regex last) 3035 "Match REGEX from point to LAST. 3036 REGEX is either `markdown-regex-math-inline-single' for matching 3037 $..$ or `markdown-regex-math-inline-double' for matching $$..$$." 3038 (when (markdown-match-inline-generic regex last) 3039 (let ((begin (match-beginning 1)) (end (match-end 1))) 3040 (prog1 3041 (if (or (markdown-range-property-any 3042 begin end 'face 3043 '(markdown-inline-code-face markdown-bold-face)) 3044 (markdown-range-properties-exist 3045 begin end 3046 (markdown-get-fenced-block-middle-properties))) 3047 (markdown-match-math-generic regex last) 3048 t) 3049 (goto-char (1+ (match-end 0))))))) 3050 3051 (defun markdown-match-list-items (last) 3052 "Match list items from point to LAST." 3053 (let* ((first (point)) 3054 (pos first) 3055 (prop 'markdown-list-item) 3056 (bounds (car (get-text-property pos prop)))) 3057 (while 3058 (and (or (null (setq bounds (car (get-text-property pos prop)))) 3059 (< (cl-first bounds) pos)) 3060 (< (point) last) 3061 (setq pos (next-single-property-change pos prop nil last)) 3062 (goto-char pos))) 3063 (when bounds 3064 (set-match-data (cl-seventh bounds)) 3065 ;; Step at least one character beyond point. Otherwise 3066 ;; `font-lock-fontify-keywords-region' infloops. 3067 (goto-char (min (1+ (max (line-end-position) first)) 3068 (point-max))) 3069 t))) 3070 3071 (defun markdown-match-math-single (last) 3072 "Match single quoted $..$ math from point to LAST." 3073 (when markdown-enable-math 3074 (when (and (char-equal (char-after) ?$) 3075 (not (bolp)) 3076 (not (char-equal (char-before) ?\\)) 3077 (not (char-equal (char-before) ?$))) 3078 (forward-char -1)) 3079 (markdown-match-math-generic markdown-regex-math-inline-single last))) 3080 3081 (defun markdown-match-math-double (last) 3082 "Match double quoted $$..$$ math from point to LAST." 3083 (when markdown-enable-math 3084 (when (and (< (1+ (point)) (point-max)) 3085 (char-equal (char-after) ?$) 3086 (char-equal (char-after (1+ (point))) ?$) 3087 (not (bolp)) 3088 (not (char-equal (char-before) ?\\)) 3089 (not (char-equal (char-before) ?$))) 3090 (forward-char -1)) 3091 (markdown-match-math-generic markdown-regex-math-inline-double last))) 3092 3093 (defun markdown-match-math-display (last) 3094 "Match bracketed display math \[..\] and \\[..\\] from point to LAST." 3095 (when markdown-enable-math 3096 (markdown-match-math-generic markdown-regex-math-display last))) 3097 3098 (defun markdown-match-propertized-text (property last) 3099 "Match text with PROPERTY from point to LAST. 3100 Restore match data previously stored in PROPERTY." 3101 (let ((saved (get-text-property (point) property)) 3102 pos) 3103 (unless saved 3104 (setq pos (next-single-property-change (point) property nil last)) 3105 (unless (= pos last) 3106 (setq saved (get-text-property pos property)))) 3107 (when saved 3108 (set-match-data saved) 3109 ;; Step at least one character beyond point. Otherwise 3110 ;; `font-lock-fontify-keywords-region' infloops. 3111 (goto-char (min (1+ (max (match-end 0) (point))) 3112 (point-max))) 3113 saved))) 3114 3115 (defun markdown-match-pre-blocks (last) 3116 "Match preformatted blocks from point to LAST. 3117 Use data stored in \\='markdown-pre text property during syntax 3118 analysis." 3119 (markdown-match-propertized-text 'markdown-pre last)) 3120 3121 (defun markdown-match-gfm-code-blocks (last) 3122 "Match GFM quoted code blocks from point to LAST. 3123 Use data stored in \\='markdown-gfm-code text property during syntax 3124 analysis." 3125 (markdown-match-propertized-text 'markdown-gfm-code last)) 3126 3127 (defun markdown-match-gfm-open-code-blocks (last) 3128 (markdown-match-propertized-text 'markdown-gfm-block-begin last)) 3129 3130 (defun markdown-match-gfm-close-code-blocks (last) 3131 (markdown-match-propertized-text 'markdown-gfm-block-end last)) 3132 3133 (defun markdown-match-fenced-code-blocks (last) 3134 "Match fenced code blocks from the point to LAST." 3135 (markdown-match-propertized-text 'markdown-fenced-code last)) 3136 3137 (defun markdown-match-fenced-start-code-block (last) 3138 (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) 3139 3140 (defun markdown-match-fenced-end-code-block (last) 3141 (markdown-match-propertized-text 'markdown-tilde-fence-end last)) 3142 3143 (defun markdown-match-blockquotes (last) 3144 "Match blockquotes from point to LAST. 3145 Use data stored in \\='markdown-blockquote text property during syntax 3146 analysis." 3147 (markdown-match-propertized-text 'markdown-blockquote last)) 3148 3149 (defun markdown-match-hr (last) 3150 "Match horizontal rules comments from the point to LAST." 3151 (markdown-match-propertized-text 'markdown-hr last)) 3152 3153 (defun markdown-match-comments (last) 3154 "Match HTML comments from the point to LAST." 3155 (when (and (skip-syntax-forward "^<" last)) 3156 (let ((beg (point))) 3157 (when (and (skip-syntax-forward "^>" last) (< (point) last)) 3158 (forward-char) 3159 (set-match-data (list beg (point))) 3160 t)))) 3161 3162 (defun markdown-match-generic-links (last ref) 3163 "Match inline links from point to LAST. 3164 When REF is non-nil, match reference links instead of standard 3165 links with URLs. 3166 This function should only be used during font-lock, as it 3167 determines syntax based on the presence of faces for previously 3168 processed elements." 3169 ;; Search for the next potential link (not in a code block). 3170 (let ((prohibited-faces '(markdown-pre-face 3171 markdown-code-face 3172 markdown-inline-code-face 3173 markdown-comment-face)) 3174 found) 3175 (while 3176 (and (not found) (< (point) last) 3177 (progn 3178 ;; Clear match data to test for a match after functions returns. 3179 (set-match-data nil) 3180 ;; Preliminary regular expression search so we can return 3181 ;; quickly upon failure. This doesn't handle malformed links 3182 ;; or nested square brackets well, so if it passes we back up 3183 ;; continue with a more precise search. 3184 (re-search-forward 3185 (if ref 3186 markdown-regex-link-reference 3187 markdown-regex-link-inline) 3188 last 'limit))) 3189 ;; Keep searching if this is in a code block, inline code, or a 3190 ;; comment, or if it is include syntax. The link text portion 3191 ;; (group 3) may contain inline code or comments, but the 3192 ;; markup, URL, and title should not be part of such elements. 3193 (if (or (markdown-range-property-any 3194 (match-beginning 0) (match-end 2) 'face prohibited-faces) 3195 (markdown-range-property-any 3196 (match-beginning 4) (match-end 0) 'face prohibited-faces) 3197 (and (char-equal (char-after (line-beginning-position)) ?<) 3198 (char-equal (char-after (1+ (line-beginning-position))) ?<))) 3199 (set-match-data nil) 3200 (setq found t)))) 3201 ;; Match opening exclamation point (optional) and left bracket. 3202 (when (match-beginning 2) 3203 (let* ((bang (match-beginning 1)) 3204 (first-begin (match-beginning 2)) 3205 ;; Find end of block to prevent matching across blocks. 3206 (end-of-block (save-excursion 3207 (progn 3208 (goto-char (match-beginning 2)) 3209 (markdown-end-of-text-block) 3210 (point)))) 3211 ;; Move over balanced expressions to closing right bracket. 3212 ;; Catch unbalanced expression errors and return nil. 3213 (first-end (condition-case nil 3214 (and (goto-char first-begin) 3215 (scan-sexps (point) 1)) 3216 (error nil))) 3217 ;; Continue with point at CONT-POINT upon failure. 3218 (cont-point (min (1+ first-begin) last)) 3219 second-begin second-end url-begin url-end 3220 title-begin title-end) 3221 ;; When bracket found, in range, and followed by a left paren/bracket... 3222 (when (and first-end (< first-end end-of-block) (goto-char first-end) 3223 (char-equal (char-after (point)) (if ref ?\[ ?\())) 3224 ;; Scan across balanced expressions for closing parenthesis/bracket. 3225 (setq second-begin (point) 3226 second-end (condition-case nil 3227 (scan-sexps (point) 1) 3228 (error nil))) 3229 ;; Check that closing parenthesis/bracket is in range. 3230 (if (and second-end (<= second-end end-of-block) (<= second-end last)) 3231 (progn 3232 ;; Search for (optional) title inside closing parenthesis 3233 (when (and (not ref) (search-forward "\"" second-end t)) 3234 (setq title-begin (1- (point)) 3235 title-end (and (goto-char second-end) 3236 (search-backward "\"" (1+ title-begin) t)) 3237 title-end (and title-end (1+ title-end)))) 3238 ;; Store URL/reference range 3239 (setq url-begin (1+ second-begin) 3240 url-end (1- (or title-begin second-end))) 3241 ;; Set match data, move point beyond link, and return 3242 (set-match-data 3243 (list (or bang first-begin) second-end ; 0 - all 3244 bang (and bang (1+ bang)) ; 1 - bang 3245 first-begin (1+ first-begin) ; 2 - markup 3246 (1+ first-begin) (1- first-end) ; 3 - link text 3247 (1- first-end) first-end ; 4 - markup 3248 second-begin (1+ second-begin) ; 5 - markup 3249 url-begin url-end ; 6 - url/reference 3250 title-begin title-end ; 7 - title 3251 (1- second-end) second-end)) ; 8 - markup 3252 ;; Nullify cont-point and leave point at end and 3253 (setq cont-point nil) 3254 (goto-char second-end)) 3255 ;; If no closing parenthesis in range, update continuation point 3256 (setq cont-point (min end-of-block second-begin)))) 3257 (cond 3258 ;; On failure, continue searching at cont-point 3259 ((and cont-point (< cont-point last)) 3260 (goto-char cont-point) 3261 (markdown-match-generic-links last ref)) 3262 ;; No more text, return nil 3263 ((and cont-point (= cont-point last)) 3264 nil) 3265 ;; Return t if a match occurred 3266 (t t))))) 3267 3268 (defun markdown-match-angle-uris (last) 3269 "Match angle bracket URIs from point to LAST." 3270 (when (markdown-match-inline-generic markdown-regex-angle-uri last) 3271 (goto-char (1+ (match-end 0))))) 3272 3273 (defun markdown-match-plain-uris (last) 3274 "Match plain URIs from point to LAST." 3275 (when (markdown-match-inline-generic markdown-regex-uri last t) 3276 (goto-char (1+ (match-end 0))))) 3277 3278 (defvar markdown-conditional-search-function #'re-search-forward 3279 "Conditional search function used in `markdown-search-until-condition'. 3280 Made into a variable to allow for dynamic let-binding.") 3281 3282 (defun markdown-search-until-condition (condition &rest args) 3283 (let (ret) 3284 (while (and (not ret) (apply markdown-conditional-search-function args)) 3285 (setq ret (funcall condition))) 3286 ret)) 3287 3288 (defun markdown-metadata-line-p (pos regexp) 3289 (save-excursion 3290 (or (= (line-number-at-pos pos) 1) 3291 (progn 3292 (forward-line -1) 3293 ;; skip multi-line metadata 3294 (while (and (looking-at-p "^\\s-+[[:alpha:]]") 3295 (> (line-number-at-pos (point)) 1)) 3296 (forward-line -1)) 3297 (looking-at-p regexp))))) 3298 3299 (defun markdown-match-generic-metadata (regexp last) 3300 "Match metadata declarations specified by REGEXP from point to LAST. 3301 These declarations must appear inside a metadata block that begins at 3302 the beginning of the buffer and ends with a blank line (or the end of 3303 the buffer)." 3304 (let* ((first (point)) 3305 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") 3306 (block-begin (goto-char 1)) 3307 (block-end (re-search-forward end-re nil t))) 3308 (if (and block-end (> first block-end)) 3309 ;; Don't match declarations if there is no metadata block or if 3310 ;; the point is beyond the block. Move point to point-max to 3311 ;; prevent additional searches and return return nil since nothing 3312 ;; was found. 3313 (progn (goto-char (point-max)) nil) 3314 ;; If a block was found that begins before LAST and ends after 3315 ;; point, search for declarations inside it. If the starting is 3316 ;; before the beginning of the block, start there. Otherwise, 3317 ;; move back to FIRST. 3318 (goto-char (if (< first block-begin) block-begin first)) 3319 (if (and (re-search-forward regexp (min last block-end) t) 3320 (markdown-metadata-line-p (point) regexp)) 3321 ;; If a metadata declaration is found, set match-data and return t. 3322 (let ((key-beginning (match-beginning 1)) 3323 (key-end (match-end 1)) 3324 (markup-begin (match-beginning 2)) 3325 (markup-end (match-end 2)) 3326 (value-beginning (match-beginning 3))) 3327 (set-match-data (list key-beginning (point) ; complete metadata 3328 key-beginning key-end ; key 3329 markup-begin markup-end ; markup 3330 value-beginning (point))) ; value 3331 t) 3332 ;; Otherwise, move the point to last and return nil 3333 (goto-char last) 3334 nil)))) 3335 3336 (defun markdown-match-declarative-metadata (last) 3337 "Match declarative metadata from the point to LAST." 3338 (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) 3339 3340 (defun markdown-match-pandoc-metadata (last) 3341 "Match Pandoc metadata from the point to LAST." 3342 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) 3343 3344 (defun markdown-match-yaml-metadata-begin (last) 3345 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) 3346 3347 (defun markdown-match-yaml-metadata-end (last) 3348 (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) 3349 3350 (defun markdown-match-yaml-metadata-key (last) 3351 (markdown-match-propertized-text 'markdown-metadata-key last)) 3352 3353 (defun markdown-match-wiki-link (last) 3354 "Match wiki links from point to LAST." 3355 (when (and markdown-enable-wiki-links 3356 (not markdown-wiki-link-fontify-missing) 3357 (markdown-match-inline-generic markdown-regex-wiki-link last)) 3358 (let ((begin (match-beginning 1)) (end (match-end 1))) 3359 (if (or (markdown-in-comment-p begin) 3360 (markdown-in-comment-p end) 3361 (markdown-inline-code-at-pos-p begin) 3362 (markdown-inline-code-at-pos-p end) 3363 (markdown-code-block-at-pos begin)) 3364 (progn (goto-char (min (1+ begin) last)) 3365 (when (< (point) last) 3366 (markdown-match-wiki-link last))) 3367 (set-match-data (list begin end)) 3368 t)))) 3369 3370 (defun markdown-match-inline-attributes (last) 3371 "Match inline attributes from point to LAST." 3372 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. 3373 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes 3374 ;; against matched string. 3375 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) 3376 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) 3377 (markdown-match-inline-attributes last) 3378 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3379 (markdown-inline-code-at-pos-p (match-end 0)) 3380 (markdown-in-comment-p)) 3381 t)))) 3382 3383 (defun markdown-match-leanpub-sections (last) 3384 "Match Leanpub section markers from point to LAST." 3385 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) 3386 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3387 (markdown-inline-code-at-pos-p (match-end 0)) 3388 (markdown-in-comment-p)) 3389 t))) 3390 3391 (defun markdown-match-includes (last) 3392 "Match include statements from point to LAST. 3393 Sets match data for the following seven groups: 3394 Group 1: opening two angle brackets 3395 Group 2: opening title delimiter (optional) 3396 Group 3: title text (optional) 3397 Group 4: closing title delimiter (optional) 3398 Group 5: opening filename delimiter 3399 Group 6: filename 3400 Group 7: closing filename delimiter" 3401 (when (markdown-match-inline-generic markdown-regex-include last) 3402 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) 3403 (markdown-in-comment-p (match-end 0)) 3404 (markdown-code-block-at-pos (match-beginning 0)))))) 3405 (cond 3406 ;; Parentheses and maybe square brackets, but no curly braces: 3407 ;; match optional title in square brackets and file in parentheses. 3408 ((and valid (match-beginning 5) 3409 (not (match-beginning 8))) 3410 (set-match-data (list (match-beginning 1) (match-end 7) 3411 (match-beginning 1) (match-end 1) 3412 (match-beginning 2) (match-end 2) 3413 (match-beginning 3) (match-end 3) 3414 (match-beginning 4) (match-end 4) 3415 (match-beginning 5) (match-end 5) 3416 (match-beginning 6) (match-end 6) 3417 (match-beginning 7) (match-end 7)))) 3418 ;; Only square brackets present: match file in square brackets. 3419 ((and valid (match-beginning 2) 3420 (not (match-beginning 5)) 3421 (not (match-beginning 7))) 3422 (set-match-data (list (match-beginning 1) (match-end 4) 3423 (match-beginning 1) (match-end 1) 3424 nil nil 3425 nil nil 3426 nil nil 3427 (match-beginning 2) (match-end 2) 3428 (match-beginning 3) (match-end 3) 3429 (match-beginning 4) (match-end 4)))) 3430 ;; Only curly braces present: match file in curly braces. 3431 ((and valid (match-beginning 8) 3432 (not (match-beginning 2)) 3433 (not (match-beginning 5))) 3434 (set-match-data (list (match-beginning 1) (match-end 10) 3435 (match-beginning 1) (match-end 1) 3436 nil nil 3437 nil nil 3438 nil nil 3439 (match-beginning 8) (match-end 8) 3440 (match-beginning 9) (match-end 9) 3441 (match-beginning 10) (match-end 10)))) 3442 (t 3443 ;; Not a valid match, move to next line and search again. 3444 (forward-line) 3445 (when (< (point) last) 3446 (setq valid (markdown-match-includes last))))) 3447 valid))) 3448 3449 (defun markdown-match-html-tag (last) 3450 "Match HTML tags from point to LAST." 3451 (when (and markdown-enable-html 3452 (markdown-match-inline-generic markdown-regex-html-tag last t)) 3453 (set-match-data (list (match-beginning 0) (match-end 0) 3454 (match-beginning 1) (match-end 1) 3455 (match-beginning 2) (match-end 2) 3456 (match-beginning 9) (match-end 9))) 3457 t)) 3458 3459 3460 ;;; Markdown Font Fontification Functions ===================================== 3461 3462 (defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) 3463 3464 (defun markdown--first-displayable (seq) 3465 "Return the first displayable character or string in SEQ. 3466 SEQ may be an atom or a sequence." 3467 (let ((c (gethash seq markdown--first-displayable-cache t))) 3468 (if (not (eq c t)) 3469 c 3470 (puthash seq 3471 (let ((seq (if (listp seq) seq (list seq)))) 3472 (cond ((stringp (car seq)) 3473 (cl-find-if 3474 (lambda (str) 3475 (and (mapcar #'char-displayable-p (string-to-list str)))) 3476 seq)) 3477 ((characterp (car seq)) 3478 (cl-find-if #'char-displayable-p seq)))) 3479 markdown--first-displayable-cache)))) 3480 3481 (defun markdown--marginalize-string (level) 3482 "Generate atx markup string of given LEVEL for left margin." 3483 (let ((margin-left-space-count 3484 (- markdown-marginalize-headers-margin-width level))) 3485 (concat (make-string margin-left-space-count ? ) 3486 (make-string level ?#)))) 3487 3488 (defun markdown-marginalize-update-current () 3489 "Update the window configuration to create a left margin." 3490 (if window-system 3491 (let* ((header-delimiter-font-width 3492 (window-font-width nil 'markdown-header-delimiter-face)) 3493 (margin-pixel-width (* markdown-marginalize-headers-margin-width 3494 header-delimiter-font-width)) 3495 (margin-char-width (/ margin-pixel-width (default-font-width)))) 3496 (set-window-margins nil margin-char-width)) 3497 ;; As a fallback, simply set margin based on character count. 3498 (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) 3499 3500 (defun markdown-fontify-headings (last) 3501 "Add text properties to headings from point to LAST." 3502 (when (markdown-match-propertized-text 'markdown-heading last) 3503 (let* ((level (markdown-outline-level)) 3504 (heading-face 3505 (intern (format "markdown-header-face-%d" level))) 3506 (heading-props `(face ,heading-face)) 3507 (left-markup-props 3508 `(face markdown-header-delimiter-face 3509 ,@(cond 3510 (markdown-hide-markup 3511 `(display "")) 3512 (markdown-marginalize-headers 3513 `(display ((margin left-margin) 3514 ,(markdown--marginalize-string level))))))) 3515 (right-markup-props 3516 `(face markdown-header-delimiter-face 3517 ,@(when markdown-hide-markup `(display "")))) 3518 (rule-props `(face markdown-header-rule-face 3519 ,@(when markdown-hide-markup `(display ""))))) 3520 (if (match-end 1) 3521 ;; Setext heading 3522 (progn (add-text-properties 3523 (match-beginning 1) (match-end 1) heading-props) 3524 (if (= level 1) 3525 (add-text-properties 3526 (match-beginning 2) (match-end 2) rule-props) 3527 (add-text-properties 3528 (match-beginning 3) (match-end 3) rule-props))) 3529 ;; atx heading 3530 (let ((header-end 3531 (if markdown-fontify-whole-heading-line 3532 (min (point-max) (1+ (match-end 0))) 3533 (match-end 0)))) 3534 (add-text-properties 3535 (match-beginning 4) (match-end 4) left-markup-props) 3536 3537 ;; If closing tag is present 3538 (if (match-end 6) 3539 (progn 3540 (if markdown-hide-markup 3541 (progn 3542 (add-text-properties 3543 (match-beginning 5) header-end heading-props) 3544 (add-text-properties 3545 (match-beginning 6) (match-end 6) right-markup-props)) 3546 (add-text-properties 3547 (match-beginning 5) (match-end 5) heading-props) 3548 (add-text-properties 3549 (match-beginning 6) header-end right-markup-props))) 3550 ;; If closing tag is not present 3551 (add-text-properties 3552 (match-beginning 5) header-end heading-props)) 3553 ))) 3554 t)) 3555 3556 (defun markdown-fontify-tables (last) 3557 (when (re-search-forward "|" last t) 3558 (when (markdown-table-at-point-p) 3559 (font-lock-append-text-property 3560 (line-beginning-position) (min (1+ (line-end-position)) (point-max)) 3561 'face 'markdown-table-face)) 3562 (forward-line 1) 3563 t)) 3564 3565 (defun markdown-fontify-blockquotes (last) 3566 "Apply font-lock properties to blockquotes from point to LAST." 3567 (when (markdown-match-blockquotes last) 3568 (let ((display-string 3569 (markdown--first-displayable markdown-blockquote-display-char))) 3570 (add-text-properties 3571 (match-beginning 1) (match-end 1) 3572 (if markdown-hide-markup 3573 `(face markdown-blockquote-face display ,display-string) 3574 `(face markdown-markup-face))) 3575 (font-lock-append-text-property 3576 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) 3577 t))) 3578 3579 (defun markdown-fontify-list-items (last) 3580 "Apply font-lock properties to list markers from point to LAST." 3581 (when (markdown-match-list-items last) 3582 (when (not (markdown-code-block-at-point-p (match-beginning 2))) 3583 (let* ((indent (length (match-string-no-properties 1))) 3584 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... 3585 (bullet (nth (mod level (length markdown-list-item-bullets)) 3586 markdown-list-item-bullets))) 3587 (add-text-properties 3588 (match-beginning 2) (match-end 2) '(face markdown-list-face)) 3589 (when markdown-hide-markup 3590 (cond 3591 ;; Unordered lists 3592 ((string-match-p "[\\*\\+-]" (match-string 2)) 3593 (add-text-properties 3594 (match-beginning 2) (match-end 2) `(display ,bullet))) 3595 ;; Definition lists 3596 ((string-equal ":" (match-string 2)) 3597 (let ((display-string 3598 (char-to-string (markdown--first-displayable 3599 markdown-definition-display-char)))) 3600 (add-text-properties (match-beginning 2) (match-end 2) 3601 `(display ,display-string)))))))) 3602 t)) 3603 3604 (defun markdown--fontify-hrs-view-mode (hr-char) 3605 (if (and hr-char (display-supports-face-attributes-p '(:extend t))) 3606 (add-text-properties 3607 (match-beginning 0) (match-end 0) 3608 `(face 3609 (:inherit markdown-hr-face :underline t :extend t) 3610 font-lock-multiline t 3611 display "\n")) 3612 (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) 3613 (add-text-properties 3614 (match-beginning 0) (match-end 0) 3615 `(face 3616 markdown-hr-face font-lock-multiline t 3617 display ,(make-string hr-len hr-char)))))) 3618 3619 (defun markdown-fontify-hrs (last) 3620 "Add text properties to horizontal rules from point to LAST." 3621 (when (markdown-match-hr last) 3622 (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) 3623 (if (and markdown-hide-markup hr-char) 3624 (markdown--fontify-hrs-view-mode hr-char) 3625 (add-text-properties 3626 (match-beginning 0) (match-end 0) 3627 `(face markdown-hr-face font-lock-multiline t))) 3628 t))) 3629 3630 (defun markdown-fontify-sub-superscripts (last) 3631 "Apply text properties to sub- and superscripts from point to LAST." 3632 (when (markdown-search-until-condition 3633 (lambda () (and (not (markdown-code-block-at-point-p)) 3634 (not (markdown-inline-code-at-point-p)) 3635 (not (markdown-in-comment-p)) 3636 (not (markdown--math-block-p)))) 3637 markdown-regex-sub-superscript last t) 3638 (let* ((subscript-p (string= (match-string 2) "~")) 3639 (props 3640 (if subscript-p 3641 (car markdown-sub-superscript-display) 3642 (cdr markdown-sub-superscript-display))) 3643 (mp (list 'face 'markdown-markup-face 3644 'invisible 'markdown-markup))) 3645 (when markdown-hide-markup 3646 (put-text-property (match-beginning 3) (match-end 3) 3647 'display props)) 3648 (add-text-properties (match-beginning 2) (match-end 2) mp) 3649 (add-text-properties (match-beginning 4) (match-end 4) mp) 3650 t))) 3651 3652 3653 ;;; Syntax Table ============================================================== 3654 3655 (defvar markdown-mode-syntax-table 3656 (let ((tab (make-syntax-table text-mode-syntax-table))) 3657 (modify-syntax-entry ?\" "." tab) 3658 tab) 3659 "Syntax table for `markdown-mode'.") 3660 3661 3662 ;;; Element Insertion ========================================================= 3663 3664 (defun markdown-ensure-blank-line-before () 3665 "If previous line is not already blank, insert a blank line before point." 3666 (unless (bolp) (insert "\n")) 3667 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) 3668 3669 (defun markdown-ensure-blank-line-after () 3670 "If following line is not already blank, insert a blank line after point. 3671 Return the point where it was originally." 3672 (save-excursion 3673 (unless (eolp) (insert "\n")) 3674 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) 3675 3676 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) 3677 "Insert the strings S1 and S2, wrapping around region or THING. 3678 If a region is specified by the optional BEG and END arguments, 3679 wrap the strings S1 and S2 around that region. 3680 If there is an active region, wrap the strings S1 and S2 around 3681 the region. If there is not an active region but the point is at 3682 THING, wrap that thing (which defaults to word). Otherwise, just 3683 insert S1 and S2 and place the point in between. Return the 3684 bounds of the entire wrapped string, or nil if nothing was wrapped 3685 and S1 and S2 were only inserted." 3686 (let (a b bounds new-point) 3687 (cond 3688 ;; Given region 3689 ((and beg end) 3690 (setq a beg 3691 b end 3692 new-point (+ (point) (length s1)))) 3693 ;; Active region 3694 ((use-region-p) 3695 (setq a (region-beginning) 3696 b (region-end) 3697 new-point (+ (point) (length s1)))) 3698 ;; Thing (word) at point 3699 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) 3700 (setq a (car bounds) 3701 b (cdr bounds) 3702 new-point (+ (point) (length s1)))) 3703 ;; No active region and no word 3704 (t 3705 (setq a (point) 3706 b (point)))) 3707 (goto-char b) 3708 (insert s2) 3709 (goto-char a) 3710 (insert s1) 3711 (when new-point (goto-char new-point)) 3712 (if (= a b) 3713 nil 3714 (setq b (+ b (length s1) (length s2))) 3715 (cons a b)))) 3716 3717 (defun markdown-point-after-unwrap (cur prefix suffix) 3718 "Return desired position of point after an unwrapping operation. 3719 CUR gives the position of the point before the operation. 3720 Additionally, two cons cells must be provided. PREFIX gives the 3721 bounds of the prefix string and SUFFIX gives the bounds of the 3722 suffix string." 3723 (cond ((< cur (cdr prefix)) (car prefix)) 3724 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) 3725 ((<= cur (cdr suffix)) 3726 (- cur (+ (- (cdr prefix) (car prefix)) 3727 (- cur (car suffix))))) 3728 (t cur))) 3729 3730 (defun markdown-unwrap-thing-at-point (regexp all text) 3731 "Remove prefix and suffix of thing at point and reposition the point. 3732 When the thing at point matches REGEXP, replace the subexpression 3733 ALL with the string in subexpression TEXT. Reposition the point 3734 in an appropriate location accounting for the removal of prefix 3735 and suffix strings. Return new bounds of string from group TEXT. 3736 When REGEXP is nil, assumes match data is already set." 3737 (when (or (null regexp) 3738 (thing-at-point-looking-at regexp)) 3739 (let ((cur (point)) 3740 (prefix (cons (match-beginning all) (match-beginning text))) 3741 (suffix (cons (match-end text) (match-end all))) 3742 (bounds (cons (match-beginning text) (match-end text)))) 3743 ;; Replace the thing at point 3744 (replace-match (match-string text) t t nil all) 3745 ;; Reposition the point 3746 (goto-char (markdown-point-after-unwrap cur prefix suffix)) 3747 ;; Adjust bounds 3748 (setq bounds (cons (car prefix) 3749 (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) 3750 3751 (defun markdown-unwrap-things-in-region (beg end regexp all text) 3752 "Remove prefix and suffix of all things in region from BEG to END. 3753 When a thing in the region matches REGEXP, replace the 3754 subexpression ALL with the string in subexpression TEXT. 3755 Return a cons cell containing updated bounds for the region." 3756 (save-excursion 3757 (goto-char beg) 3758 (let ((removed 0) len-all len-text) 3759 (while (re-search-forward regexp (- end removed) t) 3760 (setq len-all (length (match-string-no-properties all))) 3761 (setq len-text (length (match-string-no-properties text))) 3762 (setq removed (+ removed (- len-all len-text))) 3763 (replace-match (match-string text) t t nil all)) 3764 (cons beg (- end removed))))) 3765 3766 (defun markdown-insert-hr (arg) 3767 "Insert or replace a horizontal rule. 3768 By default, use the first element of `markdown-hr-strings'. When 3769 ARG is non-nil, as when given a prefix, select a different 3770 element as follows. When prefixed with \\[universal-argument], 3771 use the last element of `markdown-hr-strings' instead. When 3772 prefixed with an integer from 1 to the length of 3773 `markdown-hr-strings', use the element in that position instead." 3774 (interactive "*P") 3775 (when (thing-at-point-looking-at markdown-regex-hr) 3776 (delete-region (match-beginning 0) (match-end 0))) 3777 (markdown-ensure-blank-line-before) 3778 (cond ((equal arg '(4)) 3779 (insert (car (reverse markdown-hr-strings)))) 3780 ((and (integerp arg) (> arg 0) 3781 (<= arg (length markdown-hr-strings))) 3782 (insert (nth (1- arg) markdown-hr-strings))) 3783 (t 3784 (insert (car markdown-hr-strings)))) 3785 (markdown-ensure-blank-line-after)) 3786 3787 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face 3788 &optional skip-space) 3789 (if (use-region-p) 3790 ;; Active region 3791 (let* ((bounds (markdown-unwrap-things-in-region 3792 (region-beginning) (region-end) 3793 regex start-group end-group)) 3794 (beg (car bounds)) 3795 (end (cdr bounds))) 3796 (when (and beg skip-space) 3797 (save-excursion 3798 (goto-char beg) 3799 (skip-chars-forward "[ \t]") 3800 (setq beg (point)))) 3801 (when (and end skip-space) 3802 (save-excursion 3803 (goto-char end) 3804 (skip-chars-backward "[ \t]") 3805 (setq end (point)))) 3806 (markdown-wrap-or-insert start-delim end-delim nil beg end)) 3807 (if (markdown--face-p (point) (list face)) 3808 (save-excursion 3809 (while (and (markdown--face-p (point) (list face)) (not (bobp))) 3810 (forward-char -1)) 3811 (forward-char (- (1- (length start-delim)))) ;; for delimiter 3812 (unless (bolp) 3813 (forward-char -1)) 3814 (when (looking-at regex) 3815 (markdown-unwrap-thing-at-point nil start-group end-group))) 3816 (if (thing-at-point-looking-at regex) 3817 (markdown-unwrap-thing-at-point nil start-group end-group) 3818 (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) 3819 3820 (defun markdown-insert-bold () 3821 "Insert markup to make a region or word bold. 3822 If there is an active region, make the region bold. If the point 3823 is at a non-bold word, make the word bold. If the point is at a 3824 bold word or phrase, remove the bold markup. Otherwise, simply 3825 insert bold delimiters and place the point in between them." 3826 (interactive) 3827 (let ((delim (if markdown-bold-underscore "__" "**"))) 3828 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) 3829 3830 (defun markdown-insert-italic () 3831 "Insert markup to make a region or word italic. 3832 If there is an active region, make the region italic. If the point 3833 is at a non-italic word, make the word italic. If the point is at an 3834 italic word or phrase, remove the italic markup. Otherwise, simply 3835 insert italic delimiters and place the point in between them." 3836 (interactive) 3837 (let ((delim (if markdown-italic-underscore "_" "*"))) 3838 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) 3839 3840 (defun markdown-insert-strike-through () 3841 "Insert markup to make a region or word strikethrough. 3842 If there is an active region, make the region strikethrough. If the point 3843 is at a non-bold word, make the word strikethrough. If the point is at a 3844 strikethrough word or phrase, remove the strikethrough markup. Otherwise, 3845 simply insert bold delimiters and place the point in between them." 3846 (interactive) 3847 (markdown--insert-common 3848 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) 3849 3850 (defun markdown-insert-code () 3851 "Insert markup to make a region or word an inline code fragment. 3852 If there is an active region, make the region an inline code 3853 fragment. If the point is at a word, make the word an inline 3854 code fragment. Otherwise, simply insert code delimiters and 3855 place the point in between them." 3856 (interactive) 3857 (if (use-region-p) 3858 ;; Active region 3859 (let ((bounds (markdown-unwrap-things-in-region 3860 (region-beginning) (region-end) 3861 markdown-regex-code 1 3))) 3862 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) 3863 ;; Code markup removal, code markup for word, or empty markup insertion 3864 (if (markdown-inline-code-at-point) 3865 (markdown-unwrap-thing-at-point nil 0 2) 3866 (markdown-wrap-or-insert "`" "`" 'word nil nil)))) 3867 3868 (defun markdown-insert-kbd () 3869 "Insert markup to wrap region or word in <kbd> tags. 3870 If there is an active region, use the region. If the point is at 3871 a word, use the word. Otherwise, simply insert <kbd> tags and 3872 place the point in between them." 3873 (interactive) 3874 (if (use-region-p) 3875 ;; Active region 3876 (let ((bounds (markdown-unwrap-things-in-region 3877 (region-beginning) (region-end) 3878 markdown-regex-kbd 0 2))) 3879 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) 3880 ;; Markup removal, markup for word, or empty markup insertion 3881 (if (thing-at-point-looking-at markdown-regex-kbd) 3882 (markdown-unwrap-thing-at-point nil 0 2) 3883 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) 3884 3885 (defun markdown-insert-inline-link (text url &optional title) 3886 "Insert an inline link with TEXT pointing to URL. 3887 Optionally, the user can provide a TITLE." 3888 (let ((cur (point))) 3889 (setq title (and title (concat " \"" title "\""))) 3890 (insert (concat "[" text "](" url title ")")) 3891 (cond ((not text) (goto-char (+ 1 cur))) 3892 ((not url) (goto-char (+ 3 (length text) cur)))))) 3893 3894 (defun markdown-insert-inline-image (text url &optional title) 3895 "Insert an inline link with alt TEXT pointing to URL. 3896 Optionally, also provide a TITLE." 3897 (let ((cur (point))) 3898 (setq title (and title (concat " \"" title "\""))) 3899 (insert (concat "![" text "](" url title ")")) 3900 (cond ((not text) (goto-char (+ 2 cur))) 3901 ((not url) (goto-char (+ 4 (length text) cur)))))) 3902 3903 (defun markdown-insert-reference-link (text label &optional url title) 3904 "Insert a reference link and, optionally, a reference definition. 3905 The link TEXT will be inserted followed by the optional LABEL. 3906 If a URL is given, also insert a definition for the reference 3907 LABEL according to `markdown-reference-location'. If a TITLE is 3908 given, it will be added to the end of the reference definition 3909 and will be used to populate the title attribute when converted 3910 to XHTML. If URL is nil, insert only the link portion (for 3911 example, when a reference label is already defined)." 3912 (insert (concat "[" text "][" label "]")) 3913 (when url 3914 (markdown-insert-reference-definition 3915 (if (string-equal label "") text label) 3916 url title))) 3917 3918 (defun markdown-insert-reference-image (text label &optional url title) 3919 "Insert a reference image and, optionally, a reference definition. 3920 The alt TEXT will be inserted followed by the optional LABEL. 3921 If a URL is given, also insert a definition for the reference 3922 LABEL according to `markdown-reference-location'. If a TITLE is 3923 given, it will be added to the end of the reference definition 3924 and will be used to populate the title attribute when converted 3925 to XHTML. If URL is nil, insert only the link portion (for 3926 example, when a reference label is already defined)." 3927 (insert (concat "![" text "][" label "]")) 3928 (when url 3929 (markdown-insert-reference-definition 3930 (if (string-equal label "") text label) 3931 url title))) 3932 3933 (defun markdown-insert-reference-definition (label &optional url title) 3934 "Add definition for reference LABEL with URL and TITLE. 3935 LABEL is a Markdown reference label without square brackets. 3936 URL and TITLE are optional. When given, the TITLE will 3937 be used to populate the title attribute when converted to XHTML." 3938 ;; END specifies where to leave the point upon return 3939 (let ((end (point))) 3940 (cl-case markdown-reference-location 3941 (end (goto-char (point-max))) 3942 (immediately (markdown-end-of-text-block)) 3943 (subtree (markdown-end-of-subtree)) 3944 (header (markdown-end-of-defun))) 3945 ;; Skip backwards over local variables. This logic is similar to the one 3946 ;; used in ‘hack-local-variables’. 3947 (when (and enable-local-variables (eobp)) 3948 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) 3949 (when (let ((case-fold-search t)) 3950 (search-forward "Local Variables:" nil :move)) 3951 (beginning-of-line 0) 3952 (when (eq (char-before) ?\n) (backward-char)))) 3953 (unless (or (markdown-cur-line-blank-p) 3954 (thing-at-point-looking-at markdown-regex-reference-definition)) 3955 (insert "\n")) 3956 (insert "\n[" label "]: ") 3957 (if url 3958 (insert url) 3959 ;; When no URL is given, leave point at END following the colon 3960 (setq end (point))) 3961 (when (> (length title) 0) 3962 (insert " \"" title "\"")) 3963 (unless (looking-at-p "\n") 3964 (insert "\n")) 3965 (goto-char end) 3966 (when url 3967 (message 3968 (markdown--substitute-command-keys 3969 "Reference [%s] was defined, press \\[markdown-do] to jump there") 3970 label)))) 3971 3972 (defcustom markdown-link-make-text-function nil 3973 "Function that automatically generates a link text for a URL. 3974 3975 If non-nil, this function will be called by 3976 `markdown--insert-link-or-image' and the result will be the 3977 default link text. The function should receive exactly one 3978 argument that corresponds to the link URL." 3979 :group 'markdown 3980 :type 'function 3981 :package-version '(markdown-mode . "2.5")) 3982 3983 (defcustom markdown-disable-tooltip-prompt nil 3984 "Disable prompt for tooltip when inserting a link or image. 3985 3986 If non-nil, `markdown-insert-link' and `markdown-insert-link' 3987 will not prompt the user to insert a tooltip text for the given 3988 link or image." 3989 :group 'markdown 3990 :type 'boolean 3991 :safe 'booleanp 3992 :package-version '(markdown-mode . "2.5")) 3993 3994 (defun markdown--insert-link-or-image (image) 3995 "Interactively insert new or update an existing link or image. 3996 When IMAGE is non-nil, insert an image. Otherwise, insert a link. 3997 This is an internal function called by 3998 `markdown-insert-link' and `markdown-insert-image'." 3999 (cl-multiple-value-bind (begin end text uri ref title) 4000 (if (use-region-p) 4001 ;; Use region as either link text or URL as appropriate. 4002 (let ((region (buffer-substring-no-properties 4003 (region-beginning) (region-end)))) 4004 (if (string-match markdown-regex-uri region) 4005 ;; Region contains a URL; use it as such. 4006 (list (region-beginning) (region-end) 4007 nil (match-string 0 region) nil nil) 4008 ;; Region doesn't contain a URL, so use it as text. 4009 (list (region-beginning) (region-end) 4010 region nil nil nil))) 4011 ;; Extract and use properties of existing link, if any. 4012 (markdown-link-at-pos (point))) 4013 (let* ((ref (when ref (concat "[" ref "]"))) 4014 (defined-refs (mapcar #'car (markdown-get-defined-references))) 4015 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) 4016 (used-uris (markdown-get-used-uris)) 4017 (uri-or-ref (completing-read 4018 "URL or [reference]: " 4019 (append defined-ref-cands used-uris) 4020 nil nil (or uri ref))) 4021 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) 4022 (match-string 1 uri-or-ref)) 4023 ((string-equal "" uri-or-ref) 4024 ""))) 4025 (uri (unless ref uri-or-ref)) 4026 (text-prompt (if image 4027 "Alt text: " 4028 (if ref 4029 "Link text: " 4030 "Link text (blank for plain URL): "))) 4031 (text (or text (and markdown-link-make-text-function uri 4032 (funcall markdown-link-make-text-function uri)))) 4033 (text (completing-read text-prompt defined-refs nil nil text)) 4034 (text (if (= (length text) 0) nil text)) 4035 (plainp (and uri (not text))) 4036 (implicitp (string-equal ref "")) 4037 (ref (if implicitp text ref)) 4038 (definedp (and ref (markdown-reference-definition ref))) 4039 (ref-url (unless (or uri definedp) 4040 (completing-read "Reference URL: " used-uris))) 4041 (title (unless (or plainp definedp markdown-disable-tooltip-prompt) 4042 (read-string "Title (tooltip text, optional): " title))) 4043 (title (if (= (length title) 0) nil title))) 4044 (when (and image implicitp) 4045 (user-error "Reference required: implicit image references are invalid")) 4046 (when (and begin end) 4047 (delete-region begin end)) 4048 (cond 4049 ((and (not image) uri text) 4050 (markdown-insert-inline-link text uri title)) 4051 ((and image uri text) 4052 (markdown-insert-inline-image text uri title)) 4053 ((and ref text) 4054 (if image 4055 (markdown-insert-reference-image text (unless implicitp ref) nil title) 4056 (markdown-insert-reference-link text (unless implicitp ref) nil title)) 4057 (unless definedp 4058 (markdown-insert-reference-definition ref ref-url title))) 4059 ((and (not image) uri) 4060 (markdown-insert-uri uri)))))) 4061 4062 (defun markdown-insert-link () 4063 "Insert new or update an existing link, with interactive prompt. 4064 If the point is at an existing link or URL, update the link text, 4065 URL, reference label, and/or title. Otherwise, insert a new link. 4066 The type of link inserted (inline, reference, or plain URL) 4067 depends on which values are provided: 4068 4069 * If a URL and TEXT are given, insert an inline link: [TEXT](URL). 4070 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. 4071 * If only TEXT is given, insert an implicit reference link: [TEXT][]. 4072 * If only a URL is given, insert a plain link: <URL>. 4073 4074 In other words, to create an implicit reference link, leave the 4075 URL prompt empty and to create a plain URL link, leave the link 4076 text empty. 4077 4078 If there is an active region, use the text as the default URL, if 4079 it seems to be a URL, or link text value otherwise. 4080 4081 If a given reference is not defined, this function will 4082 additionally prompt for the URL and optional title. In this case, 4083 the reference definition is placed at the location determined by 4084 `markdown-reference-location'. In addition, it is possible to 4085 have the `markdown-link-make-text-function' function, if non-nil, 4086 define the default link text before prompting the user for it. 4087 4088 If `markdown-disable-tooltip-prompt' is non-nil, the user will 4089 not be prompted to add or modify a tooltip text. 4090 4091 Through updating the link, this function can be used to convert a 4092 link of one type (inline, reference, or plain) to another type by 4093 selectively adding or removing information via the prompts." 4094 (interactive) 4095 (markdown--insert-link-or-image nil)) 4096 4097 (defun markdown-insert-image () 4098 "Insert new or update an existing image, with interactive prompt. 4099 If the point is at an existing image, update the alt text, URL, 4100 reference label, and/or title. Otherwise, insert a new image. 4101 The type of image inserted (inline or reference) depends on which 4102 values are provided: 4103 4104 * If a URL and ALT-TEXT are given, insert an inline image: 4105 ![ALT-TEXT](URL). 4106 * If [REF] and ALT-TEXT are given, insert a reference image: 4107 ![ALT-TEXT][REF]. 4108 4109 If there is an active region, use the text as the default URL, if 4110 it seems to be a URL, or alt text value otherwise. 4111 4112 If a given reference is not defined, this function will 4113 additionally prompt for the URL and optional title. In this case, 4114 the reference definition is placed at the location determined by 4115 `markdown-reference-location'. 4116 4117 Through updating the image, this function can be used to convert an 4118 image of one type (inline or reference) to another type by 4119 selectively adding or removing information via the prompts." 4120 (interactive) 4121 (markdown--insert-link-or-image t)) 4122 4123 (defun markdown-insert-uri (&optional uri) 4124 "Insert markup for an inline URI. 4125 If there is an active region, use it as the URI. If the point is 4126 at a URI, wrap it with angle brackets. If the point is at an 4127 inline URI, remove the angle brackets. Otherwise, simply insert 4128 angle brackets place the point between them." 4129 (interactive) 4130 (if (use-region-p) 4131 ;; Active region 4132 (let ((bounds (markdown-unwrap-things-in-region 4133 (region-beginning) (region-end) 4134 markdown-regex-angle-uri 0 2))) 4135 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) 4136 ;; Markup removal, URI at point, new URI, or empty markup insertion 4137 (if (thing-at-point-looking-at markdown-regex-angle-uri) 4138 (markdown-unwrap-thing-at-point nil 0 2) 4139 (if uri 4140 (insert "<" uri ">") 4141 (markdown-wrap-or-insert "<" ">" 'url nil nil))))) 4142 4143 (defun markdown-insert-wiki-link () 4144 "Insert a wiki link of the form [[WikiLink]]. 4145 If there is an active region, use the region as the link text. 4146 If the point is at a word, use the word as the link text. If 4147 there is no active region and the point is not at word, simply 4148 insert link markup." 4149 (interactive) 4150 (if (use-region-p) 4151 ;; Active region 4152 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) 4153 ;; Markup removal, wiki link at at point, or empty markup insertion 4154 (if (thing-at-point-looking-at markdown-regex-wiki-link) 4155 (if (or markdown-wiki-link-alias-first 4156 (null (match-string 5))) 4157 (markdown-unwrap-thing-at-point nil 1 3) 4158 (markdown-unwrap-thing-at-point nil 1 5)) 4159 (markdown-wrap-or-insert "[[" "]]")))) 4160 4161 (defun markdown-remove-header () 4162 "Remove header markup if point is at a header. 4163 Return bounds of remaining header text if a header was removed 4164 and nil otherwise." 4165 (interactive "*") 4166 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) 4167 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) 4168 4169 (defun markdown-insert-header (&optional level text setext) 4170 "Insert or replace header markup. 4171 The level of the header is specified by LEVEL and header text is 4172 given by TEXT. LEVEL must be an integer from 1 and 6, and the 4173 default value is 1. 4174 When TEXT is nil, the header text is obtained as follows. 4175 If there is an active region, it is used as the header text. 4176 Otherwise, the current line will be used as the header text. 4177 If there is not an active region and the point is at a header, 4178 remove the header markup and replace with level N header. 4179 Otherwise, insert empty header markup and place the point in 4180 between. 4181 The style of the header will be atx (hash marks) unless 4182 SETEXT is non-nil, in which case a setext-style (underlined) 4183 header will be inserted." 4184 (interactive "p\nsHeader text: ") 4185 (setq level (min (max (or level 1) 1) (if setext 2 6))) 4186 ;; Determine header text if not given 4187 (when (null text) 4188 (if (use-region-p) 4189 ;; Active region 4190 (setq text (delete-and-extract-region (region-beginning) (region-end))) 4191 ;; No active region 4192 (markdown-remove-header) 4193 (setq text (delete-and-extract-region 4194 (line-beginning-position) (line-end-position))) 4195 (when (and setext (string-match-p "^[ \t]*$" text)) 4196 (setq text (read-string "Header text: ")))) 4197 (setq text (markdown-compress-whitespace-string text))) 4198 ;; Insertion with given text 4199 (markdown-ensure-blank-line-before) 4200 (let (hdr) 4201 (cond (setext 4202 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) 4203 (insert text "\n" hdr)) 4204 (t 4205 (setq hdr (make-string level ?#)) 4206 (insert hdr " " text) 4207 (when (null markdown-asymmetric-header) (insert " " hdr))))) 4208 (markdown-ensure-blank-line-after) 4209 ;; Leave point at end of text 4210 (cond (setext 4211 (backward-char (1+ (string-width text)))) 4212 ((null markdown-asymmetric-header) 4213 (backward-char (1+ level))))) 4214 4215 (defun markdown-insert-header-dwim (&optional arg setext) 4216 "Insert or replace header markup. 4217 The level and type of the header are determined automatically by 4218 the type and level of the previous header, unless a prefix 4219 argument is given via ARG. 4220 With a numeric prefix valued 1 to 6, insert a header of the given 4221 level, with the type being determined automatically (note that 4222 only level 1 or 2 setext headers are possible). 4223 4224 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 4225 promote the heading by one level. 4226 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 4227 demote the heading by one level. 4228 When SETEXT is non-nil, prefer setext-style headers when 4229 possible (levels one and two). 4230 4231 When there is an active region, use it for the header text. When 4232 the point is at an existing header, change the type and level 4233 according to the rules above. 4234 Otherwise, if the line is not empty, create a header using the 4235 text on the current line as the header text. 4236 Finally, if the point is on a blank line, insert empty header 4237 markup (atx) or prompt for text (setext). 4238 See `markdown-insert-header' for more details about how the 4239 header text is determined." 4240 (interactive "*P") 4241 (let (level) 4242 (save-excursion 4243 (when (or (thing-at-point-looking-at markdown-regex-header) 4244 (re-search-backward markdown-regex-header nil t)) 4245 ;; level of current or previous header 4246 (setq level (markdown-outline-level)) 4247 ;; match group 1 indicates a setext header 4248 (setq setext (match-end 1)))) 4249 ;; check prefix argument 4250 (cond 4251 ((and (equal arg '(4)) level (> level 1)) ;; C-u 4252 (cl-decf level)) 4253 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u 4254 (cl-incf level)) 4255 (arg ;; numeric prefix 4256 (setq level (prefix-numeric-value arg)))) 4257 ;; setext headers must be level one or two 4258 (and level (setq setext (and setext (<= level 2)))) 4259 ;; insert the heading 4260 (markdown-insert-header level nil setext))) 4261 4262 (defun markdown-insert-header-setext-dwim (&optional arg) 4263 "Insert or replace header markup, with preference for setext. 4264 See `markdown-insert-header-dwim' for details, including how ARG is handled." 4265 (interactive "*P") 4266 (markdown-insert-header-dwim arg t)) 4267 4268 (defun markdown-insert-header-atx-1 () 4269 "Insert a first level atx-style (hash mark) header. 4270 See `markdown-insert-header'." 4271 (interactive "*") 4272 (markdown-insert-header 1 nil nil)) 4273 4274 (defun markdown-insert-header-atx-2 () 4275 "Insert a level two atx-style (hash mark) header. 4276 See `markdown-insert-header'." 4277 (interactive "*") 4278 (markdown-insert-header 2 nil nil)) 4279 4280 (defun markdown-insert-header-atx-3 () 4281 "Insert a level three atx-style (hash mark) header. 4282 See `markdown-insert-header'." 4283 (interactive "*") 4284 (markdown-insert-header 3 nil nil)) 4285 4286 (defun markdown-insert-header-atx-4 () 4287 "Insert a level four atx-style (hash mark) header. 4288 See `markdown-insert-header'." 4289 (interactive "*") 4290 (markdown-insert-header 4 nil nil)) 4291 4292 (defun markdown-insert-header-atx-5 () 4293 "Insert a level five atx-style (hash mark) header. 4294 See `markdown-insert-header'." 4295 (interactive "*") 4296 (markdown-insert-header 5 nil nil)) 4297 4298 (defun markdown-insert-header-atx-6 () 4299 "Insert a sixth level atx-style (hash mark) header. 4300 See `markdown-insert-header'." 4301 (interactive "*") 4302 (markdown-insert-header 6 nil nil)) 4303 4304 (defun markdown-insert-header-setext-1 () 4305 "Insert a setext-style (underlined) first-level header. 4306 See `markdown-insert-header'." 4307 (interactive "*") 4308 (markdown-insert-header 1 nil t)) 4309 4310 (defun markdown-insert-header-setext-2 () 4311 "Insert a setext-style (underlined) second-level header. 4312 See `markdown-insert-header'." 4313 (interactive "*") 4314 (markdown-insert-header 2 nil t)) 4315 4316 (defun markdown-blockquote-indentation (loc) 4317 "Return string containing necessary indentation for a blockquote at LOC. 4318 Also see `markdown-pre-indentation'." 4319 (save-excursion 4320 (goto-char loc) 4321 (let* ((list-level (length (markdown-calculate-list-levels))) 4322 (indent "")) 4323 (dotimes (_ list-level indent) 4324 (setq indent (concat indent " ")))))) 4325 4326 (defun markdown-insert-blockquote () 4327 "Start a blockquote section (or blockquote the region). 4328 If Transient Mark mode is on and a region is active, it is used as 4329 the blockquote text." 4330 (interactive) 4331 (if (use-region-p) 4332 (markdown-blockquote-region (region-beginning) (region-end)) 4333 (markdown-ensure-blank-line-before) 4334 (insert (markdown-blockquote-indentation (point)) "> ") 4335 (markdown-ensure-blank-line-after))) 4336 4337 (defun markdown-block-region (beg end prefix) 4338 "Format the region using a block prefix. 4339 Arguments BEG and END specify the beginning and end of the 4340 region. The characters PREFIX will appear at the beginning 4341 of each line." 4342 (save-excursion 4343 (let* ((end-marker (make-marker)) 4344 (beg-marker (make-marker)) 4345 (prefix-without-trailing-whitespace 4346 (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) 4347 ;; Ensure blank line after and remove extra whitespace 4348 (goto-char end) 4349 (skip-syntax-backward "-") 4350 (set-marker end-marker (point)) 4351 (delete-horizontal-space) 4352 (markdown-ensure-blank-line-after) 4353 ;; Ensure blank line before and remove extra whitespace 4354 (goto-char beg) 4355 (skip-syntax-forward "-") 4356 (delete-horizontal-space) 4357 (markdown-ensure-blank-line-before) 4358 (set-marker beg-marker (point)) 4359 ;; Insert PREFIX before each line 4360 (goto-char beg-marker) 4361 (while (and (< (line-beginning-position) end-marker) 4362 (not (eobp))) 4363 ;; Don’t insert trailing whitespace. 4364 (insert (if (eolp) prefix-without-trailing-whitespace prefix)) 4365 (forward-line))))) 4366 4367 (defun markdown-blockquote-region (beg end) 4368 "Blockquote the region. 4369 Arguments BEG and END specify the beginning and end of the region." 4370 (interactive "*r") 4371 (markdown-block-region 4372 beg end (concat (markdown-blockquote-indentation 4373 (max (point-min) (1- beg))) "> "))) 4374 4375 (defun markdown-pre-indentation (loc) 4376 "Return string containing necessary whitespace for a pre block at LOC. 4377 Also see `markdown-blockquote-indentation'." 4378 (save-excursion 4379 (goto-char loc) 4380 (let* ((list-level (length (markdown-calculate-list-levels))) 4381 indent) 4382 (dotimes (_ (1+ list-level) indent) 4383 (setq indent (concat indent " ")))))) 4384 4385 (defun markdown-insert-pre () 4386 "Start a preformatted section (or apply to the region). 4387 If Transient Mark mode is on and a region is active, it is marked 4388 as preformatted text." 4389 (interactive) 4390 (if (use-region-p) 4391 (markdown-pre-region (region-beginning) (region-end)) 4392 (markdown-ensure-blank-line-before) 4393 (insert (markdown-pre-indentation (point))) 4394 (markdown-ensure-blank-line-after))) 4395 4396 (defun markdown-pre-region (beg end) 4397 "Format the region as preformatted text. 4398 Arguments BEG and END specify the beginning and end of the region." 4399 (interactive "*r") 4400 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) 4401 (markdown-block-region beg end indent))) 4402 4403 (defun markdown-electric-backquote (arg) 4404 "Insert a backquote. 4405 The numeric prefix argument ARG says how many times to repeat the insertion. 4406 Call `markdown-insert-gfm-code-block' interactively 4407 if three backquotes inserted at the beginning of line." 4408 (interactive "*P") 4409 (self-insert-command (prefix-numeric-value arg)) 4410 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) 4411 (replace-match "") 4412 (call-interactively #'markdown-insert-gfm-code-block))) 4413 4414 (defconst markdown-gfm-recognized-languages 4415 ;; To reproduce/update, evaluate the let-form in 4416 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, 4417 ;; but with appropriate use of a keyboard macro, indenting and filling it 4418 ;; properly is pretty fast. 4419 '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" 4420 "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" 4421 "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" 4422 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" 4423 "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" 4424 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" 4425 "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" 4426 "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" 4427 "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" 4428 "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" 4429 "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" 4430 "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" 4431 "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" 4432 "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" 4433 "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" 4434 "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" 4435 "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" 4436 "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" 4437 "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" 4438 "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" 4439 "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" 4440 "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" 4441 "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" 4442 "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" 4443 "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" 4444 "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" 4445 "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" 4446 "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" 4447 "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" 4448 "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" 4449 "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" 4450 "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" 4451 "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" 4452 "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" 4453 "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" 4454 "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" 4455 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" 4456 "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" 4457 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" 4458 "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" 4459 "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" 4460 "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" 4461 "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" 4462 "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" 4463 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" 4464 "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" 4465 "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" 4466 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" 4467 "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" 4468 "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" 4469 "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" 4470 "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" 4471 "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" 4472 "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" 4473 "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" 4474 "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" 4475 "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" 4476 "Linux-Kernel-Module" "Liquid" "Literate-Agda" 4477 "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" 4478 "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" 4479 "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" 4480 "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" 4481 "Max" "Mercury" "Mermaid" "Meson" "Metal" 4482 "Microsoft-Developer-Studio-Project" 4483 "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" 4484 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" 4485 "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" 4486 "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" 4487 "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" 4488 "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" 4489 "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" 4490 "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" 4491 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" 4492 "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" 4493 "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" 4494 "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" 4495 "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" 4496 "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" 4497 "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" 4498 "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" 4499 "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" 4500 "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" 4501 "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" 4502 "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" 4503 "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" 4504 "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" 4505 "PureBasic" "PureScript" "Pyret" "Python" "Python-console" 4506 "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" 4507 "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" 4508 "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" 4509 "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" 4510 "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" 4511 "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" 4512 "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" 4513 "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" 4514 "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" 4515 "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" 4516 "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" 4517 "ShellCheck-Config" "ShellSession" "Shen" "Sieve" 4518 "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" 4519 "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" 4520 "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" 4521 "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" 4522 "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" 4523 "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" 4524 "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" 4525 "Terraform-Template" "Texinfo" "Text" "TextGrid" 4526 "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" 4527 "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" 4528 "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" 4529 "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" 4530 "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" 4531 "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" 4532 "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" 4533 "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" 4534 "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" 4535 "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" 4536 "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" 4537 "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" 4538 "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" 4539 "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" 4540 "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" 4541 "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" 4542 "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" 4543 "reStructuredText" "robots.txt" "sed" "wisp" "xBase") 4544 "Language specifiers recognized by GitHub's syntax highlighting features.") 4545 4546 (defvar-local markdown-gfm-used-languages nil 4547 "Language names used in GFM code blocks.") 4548 4549 (defun markdown-trim-whitespace (str) 4550 (replace-regexp-in-string 4551 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) 4552 4553 (defun markdown-clean-language-string (str) 4554 (replace-regexp-in-string 4555 "{\\.?\\|}" "" (markdown-trim-whitespace str))) 4556 4557 (defun markdown-validate-language-string (widget) 4558 (let ((str (widget-value widget))) 4559 (unless (string= str (markdown-clean-language-string str)) 4560 (widget-put widget :error (format "Invalid language spec: '%s'" str)) 4561 widget))) 4562 4563 (defun markdown-gfm-get-corpus () 4564 "Create corpus of recognized GFM code block languages for the given buffer." 4565 (let ((given-corpus (append markdown-gfm-additional-languages 4566 markdown-gfm-recognized-languages))) 4567 (append 4568 markdown-gfm-used-languages 4569 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) 4570 given-corpus)))) 4571 4572 (defun markdown-gfm-add-used-language (lang) 4573 "Clean LANG and add to list of used languages." 4574 (setq markdown-gfm-used-languages 4575 (cons lang (remove lang markdown-gfm-used-languages)))) 4576 4577 (defcustom markdown-spaces-after-code-fence 1 4578 "Number of space characters to insert after a code fence. 4579 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an 4580 opening code fence and an info string." 4581 :group 'markdown 4582 :type 'integer 4583 :safe #'natnump 4584 :package-version '(markdown-mode . "2.3")) 4585 4586 (defcustom markdown-code-block-braces nil 4587 "When non-nil, automatically insert braces for GFM code blocks." 4588 :group 'markdown 4589 :type 'boolean) 4590 4591 (defun markdown-insert-gfm-code-block (&optional lang edit) 4592 "Insert GFM code block for language LANG. 4593 If LANG is nil, the language will be queried from user. If a 4594 region is active, wrap this region with the markup instead. If 4595 the region boundaries are not on empty lines, these are added 4596 automatically in order to have the correct markup. When EDIT is 4597 non-nil (e.g., when \\[universal-argument] is given), edit the 4598 code block in an indirect buffer after insertion." 4599 (interactive 4600 (list (let ((completion-ignore-case nil)) 4601 (condition-case nil 4602 (markdown-clean-language-string 4603 (completing-read 4604 "Programming language: " 4605 (markdown-gfm-get-corpus) 4606 nil 'confirm (car markdown-gfm-used-languages) 4607 'markdown-gfm-language-history)) 4608 (quit ""))) 4609 current-prefix-arg)) 4610 (unless (string= lang "") (markdown-gfm-add-used-language lang)) 4611 (when (and (> (length lang) 0) 4612 (not markdown-code-block-braces)) 4613 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) 4614 lang))) 4615 (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) 4616 (gfm-close-brace (if markdown-code-block-braces "}" ""))) 4617 (if (use-region-p) 4618 (let* ((b (region-beginning)) (e (region-end)) end 4619 (indent (progn (goto-char b) (current-indentation)))) 4620 (goto-char e) 4621 ;; if we're on a blank line, don't newline, otherwise the ``` 4622 ;; should go on its own line 4623 (unless (looking-back "\n" nil) 4624 (newline)) 4625 (indent-to indent) 4626 (insert "```") 4627 (markdown-ensure-blank-line-after) 4628 (setq end (point)) 4629 (goto-char b) 4630 ;; if we're on a blank line, insert the quotes here, otherwise 4631 ;; add a new line first 4632 (unless (looking-at-p "\n") 4633 (newline) 4634 (forward-line -1)) 4635 (markdown-ensure-blank-line-before) 4636 (indent-to indent) 4637 (insert "```" gfm-open-brace lang gfm-close-brace) 4638 (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) 4639 (let ((indent (current-indentation)) 4640 start-bol) 4641 (delete-horizontal-space :backward-only) 4642 (markdown-ensure-blank-line-before) 4643 (indent-to indent) 4644 (setq start-bol (line-beginning-position)) 4645 (insert "```" gfm-open-brace lang gfm-close-brace "\n") 4646 (indent-to indent) 4647 (unless edit (insert ?\n)) 4648 (indent-to indent) 4649 (insert "```") 4650 (markdown-ensure-blank-line-after) 4651 (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) 4652 (end-of-line 0) 4653 (when edit (markdown-edit-code-block))))) 4654 4655 (defun markdown-code-block-lang (&optional pos-prop) 4656 "Return the language name for a GFM or tilde fenced code block. 4657 The beginning of the block may be described by POS-PROP, 4658 a cons of (pos . prop) giving the position and property 4659 at the beginning of the block." 4660 (or pos-prop 4661 (setq pos-prop 4662 (markdown-max-of-seq 4663 #'car 4664 (cl-remove-if 4665 #'null 4666 (cl-mapcar 4667 #'markdown-find-previous-prop 4668 (markdown-get-fenced-block-begin-properties)))))) 4669 (when pos-prop 4670 (goto-char (car pos-prop)) 4671 (set-match-data (get-text-property (point) (cdr pos-prop))) 4672 ;; Note: Hard-coded group number assumes tilde 4673 ;; and GFM fenced code regexp groups agree. 4674 (let ((begin (match-beginning 3)) 4675 (end (match-end 3))) 4676 (when (and begin end) 4677 ;; Fix language strings beginning with periods, like ".ruby". 4678 (when (eq (char-after begin) ?.) 4679 (setq begin (1+ begin))) 4680 (buffer-substring-no-properties begin end))))) 4681 4682 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer) 4683 (with-current-buffer (or buffer (current-buffer)) 4684 (save-excursion 4685 (goto-char (point-min)) 4686 (cl-loop 4687 with prop = 'markdown-gfm-block-begin 4688 for pos-prop = (markdown-find-next-prop prop) 4689 while pos-prop 4690 for lang = (markdown-code-block-lang pos-prop) 4691 do (progn (when lang (markdown-gfm-add-used-language lang)) 4692 (goto-char (next-single-property-change (point) prop))))))) 4693 4694 (defun markdown-insert-foldable-block () 4695 "Insert details disclosure element to make content foldable. 4696 If a region is active, wrap this region with the disclosure 4697 element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." 4698 (interactive) 4699 (let ((details-open-tag "<details>") 4700 (details-close-tag "</details>") 4701 (summary-open-tag "<summary>") 4702 (summary-close-tag " </summary>")) 4703 (if (use-region-p) 4704 (let* ((b (region-beginning)) 4705 (e (region-end)) 4706 (indent (progn (goto-char b) (current-indentation)))) 4707 (goto-char e) 4708 ;; if we're on a blank line, don't newline, otherwise the tags 4709 ;; should go on its own line 4710 (unless (looking-back "\n" nil) 4711 (newline)) 4712 (indent-to indent) 4713 (insert details-close-tag) 4714 (markdown-ensure-blank-line-after) 4715 (goto-char b) 4716 ;; if we're on a blank line, insert the quotes here, otherwise 4717 ;; add a new line first 4718 (unless (looking-at-p "\n") 4719 (newline) 4720 (forward-line -1)) 4721 (markdown-ensure-blank-line-before) 4722 (indent-to indent) 4723 (insert details-open-tag "\n") 4724 (insert summary-open-tag summary-close-tag) 4725 (search-backward summary-close-tag)) 4726 (let ((indent (current-indentation))) 4727 (delete-horizontal-space :backward-only) 4728 (markdown-ensure-blank-line-before) 4729 (indent-to indent) 4730 (insert details-open-tag "\n") 4731 (insert summary-open-tag summary-close-tag "\n") 4732 (insert details-close-tag) 4733 (indent-to indent) 4734 (markdown-ensure-blank-line-after) 4735 (search-backward summary-close-tag))))) 4736 4737 4738 ;;; Footnotes ================================================================= 4739 4740 (defun markdown-footnote-counter-inc () 4741 "Increment `markdown-footnote-counter' and return the new value." 4742 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. 4743 (save-excursion 4744 (goto-char (point-min)) 4745 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") 4746 (point-max) t) 4747 (let ((fn (string-to-number (match-string 1)))) 4748 (when (> fn markdown-footnote-counter) 4749 (setq markdown-footnote-counter fn)))))) 4750 (cl-incf markdown-footnote-counter)) 4751 4752 (defun markdown-insert-footnote () 4753 "Insert footnote with a new number and move point to footnote definition." 4754 (interactive) 4755 (let ((fn (markdown-footnote-counter-inc))) 4756 (insert (format "[^%d]" fn)) 4757 (push-mark (point) t) 4758 (markdown-footnote-text-find-new-location) 4759 (markdown-ensure-blank-line-before) 4760 (unless (markdown-cur-line-blank-p) 4761 (insert "\n")) 4762 (insert (format "[^%d]: " fn)) 4763 (markdown-ensure-blank-line-after))) 4764 4765 (defun markdown-footnote-text-find-new-location () 4766 "Position the point at the proper location for a new footnote text." 4767 (cond 4768 ((eq markdown-footnote-location 'end) (goto-char (point-max))) 4769 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) 4770 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) 4771 ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) 4772 4773 (defun markdown-footnote-kill () 4774 "Kill the footnote at point. 4775 The footnote text is killed (and added to the kill ring), the 4776 footnote marker is deleted. Point has to be either at the 4777 footnote marker or in the footnote text." 4778 (interactive) 4779 (let ((marker-pos nil) 4780 (skip-deleting-marker nil) 4781 (starting-footnote-text-positions 4782 (markdown-footnote-text-positions))) 4783 (when starting-footnote-text-positions 4784 ;; We're starting in footnote text, so mark our return position and jump 4785 ;; to the marker if possible. 4786 (let ((marker-pos (markdown-footnote-find-marker 4787 (cl-first starting-footnote-text-positions)))) 4788 (if marker-pos 4789 (goto-char (1- marker-pos)) 4790 ;; If there isn't a marker, we still want to kill the text. 4791 (setq skip-deleting-marker t)))) 4792 ;; Either we didn't start in the text, or we started in the text and jumped 4793 ;; to the marker. We want to assume we're at the marker now and error if 4794 ;; we're not. 4795 (unless skip-deleting-marker 4796 (let ((marker (markdown-footnote-delete-marker))) 4797 (unless marker 4798 (error "Not at a footnote")) 4799 ;; Even if we knew the text position before, it changed when we deleted 4800 ;; the label. 4801 (setq marker-pos (cl-second marker)) 4802 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) 4803 (unless new-text-pos 4804 (error "No text for footnote `%s'" (cl-first marker))) 4805 (goto-char new-text-pos)))) 4806 (let ((pos (markdown-footnote-kill-text))) 4807 (goto-char (if starting-footnote-text-positions 4808 pos 4809 marker-pos))))) 4810 4811 (defun markdown-footnote-delete-marker () 4812 "Delete a footnote marker at point. 4813 Returns a list (ID START) containing the footnote ID and the 4814 start position of the marker before deletion. If no footnote 4815 marker was deleted, this function returns NIL." 4816 (let ((marker (markdown-footnote-marker-positions))) 4817 (when marker 4818 (delete-region (cl-second marker) (cl-third marker)) 4819 (butlast marker)))) 4820 4821 (defun markdown-footnote-kill-text () 4822 "Kill footnote text at point. 4823 Returns the start position of the footnote text before deletion, 4824 or NIL if point was not inside a footnote text. 4825 4826 The killed text is placed in the kill ring (without the footnote 4827 number)." 4828 (let ((fn (markdown-footnote-text-positions))) 4829 (when fn 4830 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) 4831 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) 4832 (kill-new (match-string 1 text)) 4833 (when (and (markdown-cur-line-blank-p) 4834 (markdown-prev-line-blank-p) 4835 (not (bobp))) 4836 (delete-region (1- (point)) (point))) 4837 (cl-second fn))))) 4838 4839 (defun markdown-footnote-goto-text () 4840 "Jump to the text of the footnote at point." 4841 (interactive) 4842 (let ((fn (car (markdown-footnote-marker-positions)))) 4843 (unless fn 4844 (user-error "Not at a footnote marker")) 4845 (let ((new-pos (markdown-footnote-find-text fn))) 4846 (unless new-pos 4847 (error "No definition found for footnote `%s'" fn)) 4848 (goto-char new-pos)))) 4849 4850 (defun markdown-footnote-return () 4851 "Return from a footnote to its footnote number in the main text." 4852 (interactive) 4853 (let ((fn (save-excursion 4854 (car (markdown-footnote-text-positions))))) 4855 (unless fn 4856 (user-error "Not in a footnote")) 4857 (let ((new-pos (markdown-footnote-find-marker fn))) 4858 (unless new-pos 4859 (error "Footnote marker `%s' not found" fn)) 4860 (goto-char new-pos)))) 4861 4862 (defun markdown-footnote-find-marker (id) 4863 "Find the location of the footnote marker with ID. 4864 The actual buffer position returned is the position directly 4865 following the marker's closing bracket. If no marker is found, 4866 NIL is returned." 4867 (save-excursion 4868 (goto-char (point-min)) 4869 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) 4870 (skip-chars-backward "^]") 4871 (point)))) 4872 4873 (defun markdown-footnote-find-text (id) 4874 "Find the location of the text of footnote ID. 4875 The actual buffer position returned is the position of the first 4876 character of the text, after the footnote's identifier. If no 4877 footnote text is found, NIL is returned." 4878 (save-excursion 4879 (goto-char (point-min)) 4880 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) 4881 (skip-chars-forward "[ \t]") 4882 (point)))) 4883 4884 (defun markdown-footnote-marker-positions () 4885 "Return the position and ID of the footnote marker point is on. 4886 The return value is a list (ID START END). If point is not on a 4887 footnote, NIL is returned." 4888 ;; first make sure we're at a footnote marker 4889 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) 4890 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) 4891 (save-excursion 4892 ;; move point between [ and ^: 4893 (if (looking-at-p "\\[") 4894 (forward-char 1) 4895 (skip-chars-backward "^[")) 4896 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) 4897 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) 4898 4899 (defun markdown-footnote-text-positions () 4900 "Return the start and end positions of the footnote text point is in. 4901 The exact return value is a list of three elements: (ID START END). 4902 The start position is the position of the opening bracket 4903 of the footnote id. The end position is directly after the 4904 newline that ends the footnote. If point is not in a footnote, 4905 NIL is returned instead." 4906 (save-excursion 4907 (let (result) 4908 (move-beginning-of-line 1) 4909 ;; Try to find the label. If we haven't found the label and we're at a blank 4910 ;; or indented line, back up if possible. 4911 (while (and 4912 (not (and (looking-at markdown-regex-footnote-definition) 4913 (setq result (list (match-string 1) (point))))) 4914 (and (not (bobp)) 4915 (or (markdown-cur-line-blank-p) 4916 (>= (current-indentation) 4)))) 4917 (forward-line -1)) 4918 (when result 4919 ;; Advance if there is a next line that is either blank or indented. 4920 ;; (Need to check if we're on the last line, because 4921 ;; markdown-next-line-blank-p returns true for last line in buffer.) 4922 (while (and (/= (line-end-position) (point-max)) 4923 (or (markdown-next-line-blank-p) 4924 (>= (markdown-next-line-indent) 4))) 4925 (forward-line)) 4926 ;; Move back while the current line is blank. 4927 (while (markdown-cur-line-blank-p) 4928 (forward-line -1)) 4929 ;; Advance to capture this line and a single trailing newline (if there 4930 ;; is one). 4931 (forward-line) 4932 (append result (list (point))))))) 4933 4934 (defun markdown-get-defined-footnotes () 4935 "Return a list of all defined footnotes. 4936 Result is an alist of pairs (MARKER . LINE), where MARKER is the 4937 footnote marker, a string, and LINE is the line number containing 4938 the footnote definition. 4939 4940 For example, suppose the following footnotes are defined at positions 4941 448 and 475: 4942 4943 \[^1]: First footnote here. 4944 \[^marker]: Second footnote. 4945 4946 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" 4947 (save-excursion 4948 (goto-char (point-min)) 4949 (let (footnotes) 4950 (while (markdown-search-until-condition 4951 (lambda () (and (not (markdown-code-block-at-point-p)) 4952 (not (markdown-inline-code-at-point-p)) 4953 (not (markdown-in-comment-p)))) 4954 markdown-regex-footnote-definition nil t) 4955 (let ((marker (match-string-no-properties 1)) 4956 (pos (match-beginning 0))) 4957 (unless (zerop (length marker)) 4958 (cl-pushnew (cons marker pos) footnotes :test #'equal)))) 4959 (reverse footnotes)))) 4960 4961 4962 ;;; Element Removal =========================================================== 4963 4964 (defun markdown-kill-thing-at-point () 4965 "Kill thing at point and add important text, without markup, to kill ring. 4966 Possible things to kill include (roughly in order of precedence): 4967 inline code, headers, horizontal rules, links (add link text to 4968 kill ring), images (add alt text to kill ring), angle uri, email 4969 addresses, bold, italics, reference definition (add URI to kill 4970 ring), footnote markers and text (kill both marker and text, add 4971 text to kill ring), and list items." 4972 (interactive "*") 4973 (let (val) 4974 (cond 4975 ;; Inline code 4976 ((markdown-inline-code-at-point) 4977 (kill-new (match-string 2)) 4978 (delete-region (match-beginning 0) (match-end 0))) 4979 ;; ATX header 4980 ((thing-at-point-looking-at markdown-regex-header-atx) 4981 (kill-new (match-string 2)) 4982 (delete-region (match-beginning 0) (match-end 0))) 4983 ;; Setext header 4984 ((thing-at-point-looking-at markdown-regex-header-setext) 4985 (kill-new (match-string 1)) 4986 (delete-region (match-beginning 0) (match-end 0))) 4987 ;; Horizontal rule 4988 ((thing-at-point-looking-at markdown-regex-hr) 4989 (kill-new (match-string 0)) 4990 (delete-region (match-beginning 0) (match-end 0))) 4991 ;; Inline link or image (add link or alt text to kill ring) 4992 ((thing-at-point-looking-at markdown-regex-link-inline) 4993 (kill-new (match-string 3)) 4994 (delete-region (match-beginning 0) (match-end 0))) 4995 ;; Reference link or image (add link or alt text to kill ring) 4996 ((thing-at-point-looking-at markdown-regex-link-reference) 4997 (kill-new (match-string 3)) 4998 (delete-region (match-beginning 0) (match-end 0))) 4999 ;; Angle URI (add URL to kill ring) 5000 ((thing-at-point-looking-at markdown-regex-angle-uri) 5001 (kill-new (match-string 2)) 5002 (delete-region (match-beginning 0) (match-end 0))) 5003 ;; Email address in angle brackets (add email address to kill ring) 5004 ((thing-at-point-looking-at markdown-regex-email) 5005 (kill-new (match-string 1)) 5006 (delete-region (match-beginning 0) (match-end 0))) 5007 ;; Wiki link (add alias text to kill ring) 5008 ((and markdown-enable-wiki-links 5009 (thing-at-point-looking-at markdown-regex-wiki-link)) 5010 (kill-new (markdown-wiki-link-alias)) 5011 (delete-region (match-beginning 1) (match-end 1))) 5012 ;; Bold 5013 ((thing-at-point-looking-at markdown-regex-bold) 5014 (kill-new (match-string 4)) 5015 (delete-region (match-beginning 2) (match-end 2))) 5016 ;; Italics 5017 ((thing-at-point-looking-at markdown-regex-italic) 5018 (kill-new (match-string 3)) 5019 (delete-region (match-beginning 1) (match-end 1))) 5020 ;; Strikethrough 5021 ((thing-at-point-looking-at markdown-regex-strike-through) 5022 (kill-new (match-string 4)) 5023 (delete-region (match-beginning 2) (match-end 2))) 5024 ;; Footnote marker (add footnote text to kill ring) 5025 ((thing-at-point-looking-at markdown-regex-footnote) 5026 (markdown-footnote-kill)) 5027 ;; Footnote text (add footnote text to kill ring) 5028 ((setq val (markdown-footnote-text-positions)) 5029 (markdown-footnote-kill)) 5030 ;; Reference definition (add URL to kill ring) 5031 ((thing-at-point-looking-at markdown-regex-reference-definition) 5032 (kill-new (match-string 5)) 5033 (delete-region (match-beginning 0) (match-end 0))) 5034 ;; List item 5035 ((setq val (markdown-cur-list-item-bounds)) 5036 (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) 5037 (t 5038 (user-error "Nothing found at point to kill"))))) 5039 5040 (defun markdown-kill-outline () 5041 "Kill visible heading and add it to `kill-ring'." 5042 (interactive) 5043 (save-excursion 5044 (markdown-outline-previous) 5045 (kill-region (point) (progn (markdown-outline-next) (point))))) 5046 5047 (defun markdown-kill-block () 5048 "Kill visible code block, list item, or blockquote and add it to `kill-ring'." 5049 (interactive) 5050 (save-excursion 5051 (markdown-backward-block) 5052 (kill-region (point) (progn (markdown-forward-block) (point))))) 5053 5054 5055 ;;; Indentation =============================================================== 5056 5057 (defun markdown-indent-find-next-position (cur-pos positions) 5058 "Return the position after the index of CUR-POS in POSITIONS. 5059 Positions are calculated by `markdown-calc-indents'." 5060 (while (and positions 5061 (not (equal cur-pos (car positions)))) 5062 (setq positions (cdr positions))) 5063 (or (cadr positions) 0)) 5064 5065 (defun markdown-outdent-find-next-position (cur-pos positions) 5066 "Return the maximal element that precedes CUR-POS from POSITIONS. 5067 Positions are calculated by `markdown-calc-indents'." 5068 (let ((result 0)) 5069 (dolist (i positions) 5070 (when (< i cur-pos) 5071 (setq result (max result i)))) 5072 result)) 5073 5074 (defun markdown-indent-line () 5075 "Indent the current line using some heuristics. 5076 If the _previous_ command was either `markdown-enter-key' or 5077 `markdown-cycle', then we should cycle to the next 5078 reasonable indentation position. Otherwise, we could have been 5079 called directly by `markdown-enter-key', by an initial call of 5080 `markdown-cycle', or indirectly by `auto-fill-mode'. In 5081 these cases, indent to the default position. 5082 Positions are calculated by `markdown-calc-indents'." 5083 (interactive) 5084 (let ((positions (markdown-calc-indents)) 5085 (point-pos (current-column)) 5086 (_ (back-to-indentation)) 5087 (cur-pos (current-column))) 5088 (if (not (equal this-command 'markdown-cycle)) 5089 (indent-line-to (car positions)) 5090 (setq positions (sort (delete-dups positions) '<)) 5091 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) 5092 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) 5093 (indent-line-to next-pos) 5094 (move-to-column new-point-pos))))) 5095 5096 (defun markdown-calc-indents () 5097 "Return a list of indentation columns to cycle through. 5098 The first element in the returned list should be considered the 5099 default indentation level. This function does not worry about 5100 duplicate positions, which are handled up by calling functions." 5101 (let (pos prev-line-pos positions) 5102 5103 ;; Indentation of previous line 5104 (setq prev-line-pos (markdown-prev-line-indent)) 5105 (setq positions (cons prev-line-pos positions)) 5106 5107 ;; Indentation of previous non-list-marker text 5108 (when (setq pos (save-excursion 5109 (forward-line -1) 5110 (when (looking-at markdown-regex-list) 5111 (- (match-end 3) (match-beginning 0))))) 5112 (setq positions (cons pos positions))) 5113 5114 ;; Indentation required for a pre block in current context 5115 (setq pos (length (markdown-pre-indentation (point)))) 5116 (setq positions (cons pos positions)) 5117 5118 ;; Indentation of the previous line + tab-width 5119 (if prev-line-pos 5120 (setq positions (cons (+ prev-line-pos tab-width) positions)) 5121 (setq positions (cons tab-width positions))) 5122 5123 ;; Indentation of the previous line - tab-width 5124 (if (and prev-line-pos (> prev-line-pos tab-width)) 5125 (setq positions (cons (- prev-line-pos tab-width) positions))) 5126 5127 ;; Indentation of all preceding list markers (when in a list) 5128 (when (setq pos (markdown-calculate-list-levels)) 5129 (setq positions (append pos positions))) 5130 5131 ;; First column 5132 (setq positions (cons 0 positions)) 5133 5134 ;; Return reversed list 5135 (reverse positions))) 5136 5137 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent 5138 "Handle RET depending on the context. 5139 If the point is at a table, move to the next row. Otherwise, 5140 indent according to value of `markdown-indent-on-enter'. 5141 When it is nil, simply call `newline'. Otherwise, indent the next line 5142 following RET using `markdown-indent-line'. Furthermore, when it 5143 is set to \\='indent-and-new-item and the point is in a list item, 5144 start a new item with the same indentation. If the point is in an 5145 empty list item, remove it (so that pressing RET twice when in a 5146 list simply adds a blank line)." 5147 (interactive) 5148 (cond 5149 ;; Table 5150 ((markdown-table-at-point-p) 5151 (call-interactively #'markdown-table-next-row)) 5152 ;; Indent non-table text 5153 (markdown-indent-on-enter 5154 (let (bounds) 5155 (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) 5156 (setq bounds (markdown-cur-list-item-bounds))) 5157 (let ((beg (cl-first bounds)) 5158 (end (cl-second bounds)) 5159 (nonlist-indent (cl-fourth bounds)) 5160 (checkbox (cl-sixth bounds))) 5161 ;; Point is in a list item 5162 (if (= (- end beg) (+ nonlist-indent (length checkbox))) 5163 ;; Delete blank list 5164 (progn 5165 (delete-region beg end) 5166 (newline) 5167 (markdown-indent-line)) 5168 (call-interactively #'markdown-insert-list-item))) 5169 ;; Point is not in a list 5170 (newline) 5171 (markdown-indent-line)))) 5172 ;; Insert a raw newline 5173 (t (newline)))) 5174 5175 (defun markdown-outdent-or-delete (arg) 5176 "Handle BACKSPACE by cycling through indentation points. 5177 When BACKSPACE is pressed, if there is only whitespace 5178 before the current point, then outdent the line one level. 5179 Otherwise, do normal delete by repeating 5180 `backward-delete-char-untabify' ARG times." 5181 (interactive "*p") 5182 (if (use-region-p) 5183 (backward-delete-char-untabify arg) 5184 (let ((cur-pos (current-column)) 5185 (start-of-indention (save-excursion 5186 (back-to-indentation) 5187 (current-column))) 5188 (positions (markdown-calc-indents))) 5189 (if (and (> cur-pos 0) (= cur-pos start-of-indention)) 5190 (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) 5191 (backward-delete-char-untabify arg))))) 5192 5193 (defun markdown-find-leftmost-column (beg end) 5194 "Find the leftmost column in the region from BEG to END." 5195 (let ((mincol 1000)) 5196 (save-excursion 5197 (goto-char beg) 5198 (while (< (point) end) 5199 (back-to-indentation) 5200 (unless (looking-at-p "[ \t]*$") 5201 (setq mincol (min mincol (current-column)))) 5202 (forward-line 1) 5203 )) 5204 mincol)) 5205 5206 (defun markdown-indent-region (beg end arg) 5207 "Indent the region from BEG to END using some heuristics. 5208 When ARG is non-nil, outdent the region instead. 5209 See `markdown-indent-line' and `markdown-indent-line'." 5210 (interactive "*r\nP") 5211 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) 5212 (leftmostcol (markdown-find-leftmost-column beg end)) 5213 (next-pos (if arg 5214 (markdown-outdent-find-next-position leftmostcol positions) 5215 (markdown-indent-find-next-position leftmostcol positions)))) 5216 (indent-rigidly beg end (- next-pos leftmostcol)) 5217 (setq deactivate-mark nil))) 5218 5219 (defun markdown-outdent-region (beg end) 5220 "Call `markdown-indent-region' on region from BEG to END with prefix." 5221 (interactive "*r") 5222 (markdown-indent-region beg end t)) 5223 5224 (defun markdown--indent-region (start end) 5225 (let ((deactivate-mark nil)) 5226 (save-excursion 5227 (goto-char end) 5228 (setq end (point-marker)) 5229 (goto-char start) 5230 (when (bolp) 5231 (forward-line 1)) 5232 (while (< (point) end) 5233 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) 5234 (indent-according-to-mode)) 5235 (forward-line 1)) 5236 (move-marker end nil)))) 5237 5238 5239 ;;; Markup Completion ========================================================= 5240 5241 (defconst markdown-complete-alist 5242 '((markdown-regex-header-atx . markdown-complete-atx) 5243 (markdown-regex-header-setext . markdown-complete-setext) 5244 (markdown-regex-hr . markdown-complete-hr)) 5245 "Association list of form (regexp . function) for markup completion.") 5246 5247 (defun markdown-incomplete-atx-p () 5248 "Return t if ATX header markup is incomplete and nil otherwise. 5249 Assumes match data is available for `markdown-regex-header-atx'. 5250 Checks that the number of trailing hash marks equals the number of leading 5251 hash marks, that there is only a single space before and after the text, 5252 and that there is no extraneous whitespace in the text." 5253 (or 5254 ;; Number of starting and ending hash marks differs 5255 (not (= (length (match-string 1)) (length (match-string 3)))) 5256 ;; When the header text is not empty... 5257 (and (> (length (match-string 2)) 0) 5258 ;; ...if there are extra leading, trailing, or interior spaces 5259 (or (not (= (match-beginning 2) (1+ (match-end 1)))) 5260 (not (= (match-beginning 3) (1+ (match-end 2)))) 5261 (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) 5262 ;; When the header text is empty... 5263 (and (= (length (match-string 2)) 0) 5264 ;; ...if there are too many or too few spaces 5265 (not (= (match-beginning 3) (+ (match-end 1) 2)))))) 5266 5267 (defun markdown-complete-atx () 5268 "Complete and normalize ATX headers. 5269 Add or remove hash marks to the end of the header to match the 5270 beginning. Ensure that there is only a single space between hash 5271 marks and header text. Removes extraneous whitespace from header text. 5272 Assumes match data is available for `markdown-regex-header-atx'. 5273 Return nil if markup was complete and non-nil if markup was completed." 5274 (when (markdown-incomplete-atx-p) 5275 (let* ((new-marker (make-marker)) 5276 (new-marker (set-marker new-marker (match-end 2)))) 5277 ;; Hash marks and spacing at end 5278 (goto-char (match-end 2)) 5279 (delete-region (match-end 2) (match-end 3)) 5280 (insert " " (match-string 1)) 5281 ;; Remove extraneous whitespace from title 5282 (replace-match (markdown-compress-whitespace-string (match-string 2)) 5283 t t nil 2) 5284 ;; Spacing at beginning 5285 (goto-char (match-end 1)) 5286 (delete-region (match-end 1) (match-beginning 2)) 5287 (insert " ") 5288 ;; Leave point at end of text 5289 (goto-char new-marker)))) 5290 5291 (defun markdown-incomplete-setext-p () 5292 "Return t if setext header markup is incomplete and nil otherwise. 5293 Assumes match data is available for `markdown-regex-header-setext'. 5294 Checks that length of underline matches text and that there is no 5295 extraneous whitespace in the text." 5296 (or (not (= (length (match-string 1)) (length (match-string 2)))) 5297 (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) 5298 5299 (defun markdown-complete-setext () 5300 "Complete and normalize setext headers. 5301 Add or remove underline characters to match length of header 5302 text. Removes extraneous whitespace from header text. Assumes 5303 match data is available for `markdown-regex-header-setext'. 5304 Return nil if markup was complete and non-nil if markup was completed." 5305 (when (markdown-incomplete-setext-p) 5306 (let* ((text (markdown-compress-whitespace-string (match-string 1))) 5307 (char (char-after (match-beginning 2))) 5308 (level (if (char-equal char ?-) 2 1))) 5309 (goto-char (match-beginning 0)) 5310 (delete-region (match-beginning 0) (match-end 0)) 5311 (markdown-insert-header level text t) 5312 t))) 5313 5314 (defun markdown-incomplete-hr-p () 5315 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. 5316 Assumes match data is available for `markdown-regex-hr'." 5317 (not (member (match-string 0) markdown-hr-strings))) 5318 5319 (defun markdown-complete-hr () 5320 "Complete horizontal rules. 5321 If horizontal rule string is a member of `markdown-hr-strings', 5322 do nothing. Otherwise, replace with the car of 5323 `markdown-hr-strings'. 5324 Assumes match data is available for `markdown-regex-hr'. 5325 Return nil if markup was complete and non-nil if markup was completed." 5326 (when (markdown-incomplete-hr-p) 5327 (replace-match (car markdown-hr-strings)) 5328 t)) 5329 5330 (defun markdown-complete () 5331 "Complete markup of object near point or in region when active. 5332 Handle all objects in `markdown-complete-alist', in order. 5333 See `markdown-complete-at-point' and `markdown-complete-region'." 5334 (interactive "*") 5335 (if (use-region-p) 5336 (markdown-complete-region (region-beginning) (region-end)) 5337 (markdown-complete-at-point))) 5338 5339 (defun markdown-complete-at-point () 5340 "Complete markup of object near point. 5341 Handle all elements of `markdown-complete-alist' in order." 5342 (interactive "*") 5343 (let ((list markdown-complete-alist) found changed) 5344 (while list 5345 (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? 5346 (function (cdar list))) 5347 (setq list (cdr list)) 5348 (when (thing-at-point-looking-at regexp) 5349 (setq found t) 5350 (setq changed (funcall function)) 5351 (setq list nil)))) 5352 (if found 5353 (or changed (user-error "Markup at point is complete")) 5354 (user-error "Nothing to complete at point")))) 5355 5356 (defun markdown-complete-region (beg end) 5357 "Complete markup of objects in region from BEG to END. 5358 Handle all objects in `markdown-complete-alist', in order. Each 5359 match is checked to ensure that a previous regexp does not also 5360 match." 5361 (interactive "*r") 5362 (let ((end-marker (set-marker (make-marker) end)) 5363 previous) 5364 (dolist (element markdown-complete-alist) 5365 (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? 5366 (function (cdr element))) 5367 (goto-char beg) 5368 (while (re-search-forward regexp end-marker 'limit) 5369 (when (match-string 0) 5370 ;; Make sure this is not a match for any of the preceding regexps. 5371 ;; This prevents mistaking an HR for a Setext subheading. 5372 (let (match) 5373 (save-match-data 5374 (dolist (prev-regexp previous) 5375 (or match (setq match (looking-back prev-regexp nil))))) 5376 (unless match 5377 (save-excursion (funcall function)))))) 5378 (cl-pushnew regexp previous :test #'equal))) 5379 previous)) 5380 5381 (defun markdown-complete-buffer () 5382 "Complete markup for all objects in the current buffer." 5383 (interactive "*") 5384 (markdown-complete-region (point-min) (point-max))) 5385 5386 5387 ;;; Markup Cycling ============================================================ 5388 5389 (defun markdown-cycle-atx (arg &optional remove) 5390 "Cycle ATX header markup. 5391 Promote header (decrease level) when ARG is 1 and demote 5392 header (increase level) if arg is -1. When REMOVE is non-nil, 5393 remove the header when the level reaches zero and stop cycling 5394 when it reaches six. Otherwise, perform a proper cycling through 5395 levels one through six. Assumes match data is available for 5396 `markdown-regex-header-atx'." 5397 (let* ((old-level (length (match-string 1))) 5398 (new-level (+ old-level arg)) 5399 (text (match-string 2))) 5400 (when (not remove) 5401 (setq new-level (% new-level 6)) 5402 (setq new-level (cond ((= new-level 0) 6) 5403 ((< new-level 0) (+ new-level 6)) 5404 (t new-level)))) 5405 (cond 5406 ((= new-level 0) 5407 (markdown-unwrap-thing-at-point nil 0 2)) 5408 ((<= new-level 6) 5409 (goto-char (match-beginning 0)) 5410 (delete-region (match-beginning 0) (match-end 0)) 5411 (markdown-insert-header new-level text nil))))) 5412 5413 (defun markdown-cycle-setext (arg &optional remove) 5414 "Cycle setext header markup. 5415 Promote header (increase level) when ARG is 1 and demote 5416 header (decrease level or remove) if arg is -1. When demoting a 5417 level-two setext header, replace with a level-three atx header. 5418 When REMOVE is non-nil, remove the header when the level reaches 5419 zero. Otherwise, cycle back to a level six atx header. Assumes 5420 match data is available for `markdown-regex-header-setext'." 5421 (let* ((char (char-after (match-beginning 2))) 5422 (old-level (if (char-equal char ?=) 1 2)) 5423 (new-level (+ old-level arg))) 5424 (when (and (not remove) (= new-level 0)) 5425 (setq new-level 6)) 5426 (cond 5427 ((= new-level 0) 5428 (markdown-unwrap-thing-at-point nil 0 1)) 5429 ((<= new-level 2) 5430 (markdown-insert-header new-level nil t)) 5431 ((<= new-level 6) 5432 (markdown-insert-header new-level nil nil))))) 5433 5434 (defun markdown-cycle-hr (arg &optional remove) 5435 "Cycle string used for horizontal rule from `markdown-hr-strings'. 5436 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle 5437 backwards (promote). When REMOVE is non-nil, remove the hr instead 5438 of cycling when the end of the list is reached. 5439 Assumes match data is available for `markdown-regex-hr'." 5440 (let* ((strings (if (= arg -1) 5441 (reverse markdown-hr-strings) 5442 markdown-hr-strings)) 5443 (tail (member (match-string 0) strings)) 5444 (new (or (cadr tail) 5445 (if remove 5446 (if (= arg 1) 5447 "" 5448 (car tail)) 5449 (car strings))))) 5450 (replace-match new))) 5451 5452 (defun markdown-cycle-bold () 5453 "Cycle bold markup between underscores and asterisks. 5454 Assumes match data is available for `markdown-regex-bold'." 5455 (save-excursion 5456 (let* ((old-delim (match-string 3)) 5457 (new-delim (if (string-equal old-delim "**") "__" "**"))) 5458 (replace-match new-delim t t nil 3) 5459 (replace-match new-delim t t nil 5)))) 5460 5461 (defun markdown-cycle-italic () 5462 "Cycle italic markup between underscores and asterisks. 5463 Assumes match data is available for `markdown-regex-italic'." 5464 (save-excursion 5465 (let* ((old-delim (match-string 2)) 5466 (new-delim (if (string-equal old-delim "*") "_" "*"))) 5467 (replace-match new-delim t t nil 2) 5468 (replace-match new-delim t t nil 4)))) 5469 5470 5471 ;;; Keymap ==================================================================== 5472 5473 (defun markdown--style-map-prompt () 5474 "Return a formatted prompt for Markdown markup insertion." 5475 (when markdown-enable-prefix-prompts 5476 (concat 5477 "Markdown: " 5478 (propertize "bold" 'face 'markdown-bold-face) ", " 5479 (propertize "italic" 'face 'markdown-italic-face) ", " 5480 (propertize "code" 'face 'markdown-inline-code-face) ", " 5481 (propertize "C = GFM code" 'face 'markdown-code-face) ", " 5482 (propertize "pre" 'face 'markdown-pre-face) ", " 5483 (propertize "footnote" 'face 'markdown-footnote-text-face) ", " 5484 (propertize "F = foldable" 'face 'markdown-bold-face) ", " 5485 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " 5486 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " 5487 (propertize "- = hr" 'face 'markdown-hr-face) ", " 5488 "C-h = more"))) 5489 5490 (defun markdown--command-map-prompt () 5491 "Return prompt for Markdown buffer-wide commands." 5492 (when markdown-enable-prefix-prompts 5493 (concat 5494 "Command: " 5495 (propertize "m" 'face 'markdown-bold-face) "arkdown, " 5496 (propertize "p" 'face 'markdown-bold-face) "review, " 5497 (propertize "o" 'face 'markdown-bold-face) "pen, " 5498 (propertize "e" 'face 'markdown-bold-face) "xport, " 5499 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " 5500 (propertize "c" 'face 'markdown-bold-face) "heck refs, " 5501 (propertize "u" 'face 'markdown-bold-face) "nused refs, " 5502 "C-h = more"))) 5503 5504 (defvar markdown-mode-style-map 5505 (let ((map (make-keymap (markdown--style-map-prompt)))) 5506 (define-key map (kbd "1") 'markdown-insert-header-atx-1) 5507 (define-key map (kbd "2") 'markdown-insert-header-atx-2) 5508 (define-key map (kbd "3") 'markdown-insert-header-atx-3) 5509 (define-key map (kbd "4") 'markdown-insert-header-atx-4) 5510 (define-key map (kbd "5") 'markdown-insert-header-atx-5) 5511 (define-key map (kbd "6") 'markdown-insert-header-atx-6) 5512 (define-key map (kbd "!") 'markdown-insert-header-setext-1) 5513 (define-key map (kbd "@") 'markdown-insert-header-setext-2) 5514 (define-key map (kbd "b") 'markdown-insert-bold) 5515 (define-key map (kbd "c") 'markdown-insert-code) 5516 (define-key map (kbd "C") 'markdown-insert-gfm-code-block) 5517 (define-key map (kbd "f") 'markdown-insert-footnote) 5518 (define-key map (kbd "F") 'markdown-insert-foldable-block) 5519 (define-key map (kbd "h") 'markdown-insert-header-dwim) 5520 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) 5521 (define-key map (kbd "i") 'markdown-insert-italic) 5522 (define-key map (kbd "k") 'markdown-insert-kbd) 5523 (define-key map (kbd "l") 'markdown-insert-link) 5524 (define-key map (kbd "p") 'markdown-insert-pre) 5525 (define-key map (kbd "P") 'markdown-pre-region) 5526 (define-key map (kbd "q") 'markdown-insert-blockquote) 5527 (define-key map (kbd "s") 'markdown-insert-strike-through) 5528 (define-key map (kbd "t") 'markdown-insert-table) 5529 (define-key map (kbd "Q") 'markdown-blockquote-region) 5530 (define-key map (kbd "w") 'markdown-insert-wiki-link) 5531 (define-key map (kbd "-") 'markdown-insert-hr) 5532 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) 5533 ;; Deprecated keys that may be removed in a future version 5534 (define-key map (kbd "e") 'markdown-insert-italic) 5535 map) 5536 "Keymap for Markdown text styling commands.") 5537 5538 (defvar markdown-mode-command-map 5539 (let ((map (make-keymap (markdown--command-map-prompt)))) 5540 (define-key map (kbd "m") 'markdown-other-window) 5541 (define-key map (kbd "p") 'markdown-preview) 5542 (define-key map (kbd "e") 'markdown-export) 5543 (define-key map (kbd "v") 'markdown-export-and-preview) 5544 (define-key map (kbd "o") 'markdown-open) 5545 (define-key map (kbd "l") 'markdown-live-preview-mode) 5546 (define-key map (kbd "w") 'markdown-kill-ring-save) 5547 (define-key map (kbd "c") 'markdown-check-refs) 5548 (define-key map (kbd "u") 'markdown-unused-refs) 5549 (define-key map (kbd "n") 'markdown-cleanup-list-numbers) 5550 (define-key map (kbd "]") 'markdown-complete-buffer) 5551 (define-key map (kbd "^") 'markdown-table-sort-lines) 5552 (define-key map (kbd "|") 'markdown-table-convert-region) 5553 (define-key map (kbd "t") 'markdown-table-transpose) 5554 map) 5555 "Keymap for Markdown buffer-wide commands.") 5556 5557 (defvar markdown-mode-map 5558 (let ((map (make-keymap))) 5559 ;; Markup insertion & removal 5560 (define-key map (kbd "C-c C-s") markdown-mode-style-map) 5561 (define-key map (kbd "C-c C-l") 'markdown-insert-link) 5562 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) 5563 ;; Promotion, demotion, and cycling 5564 (define-key map (kbd "C-c C--") 'markdown-promote) 5565 (define-key map (kbd "C-c C-=") 'markdown-demote) 5566 (define-key map (kbd "C-c C-]") 'markdown-complete) 5567 ;; Following and doing things 5568 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) 5569 (define-key map (kbd "C-c C-d") 'markdown-do) 5570 (define-key map (kbd "C-c '") 'markdown-edit-code-block) 5571 ;; Indentation 5572 (define-key map (kbd "RET") 'markdown-enter-key) 5573 (define-key map (kbd "DEL") 'markdown-outdent-or-delete) 5574 (define-key map (kbd "C-c >") 'markdown-indent-region) 5575 (define-key map (kbd "C-c <") 'markdown-outdent-region) 5576 ;; Visibility cycling 5577 (define-key map (kbd "TAB") 'markdown-cycle) 5578 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by 5579 ;; (local-)function-key-map. 5580 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) 5581 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) 5582 (define-key map (kbd "<backtab>") 'markdown-shifttab) 5583 ;; Heading and list navigation 5584 (define-key map (kbd "C-c C-n") 'markdown-outline-next) 5585 (define-key map (kbd "C-c C-p") 'markdown-outline-previous) 5586 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) 5587 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) 5588 (define-key map (kbd "C-c C-u") 'markdown-outline-up) 5589 ;; Buffer-wide commands 5590 (define-key map (kbd "C-c C-c") markdown-mode-command-map) 5591 ;; Subtree, list, and table editing 5592 (define-key map (kbd "C-c <up>") 'markdown-move-up) 5593 (define-key map (kbd "C-c <down>") 'markdown-move-down) 5594 (define-key map (kbd "C-c <left>") 'markdown-promote) 5595 (define-key map (kbd "C-c <right>") 'markdown-demote) 5596 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) 5597 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) 5598 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) 5599 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) 5600 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) 5601 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) 5602 (define-key map (kbd "M-RET") 'markdown-insert-list-item) 5603 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) 5604 ;; Lines 5605 (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) 5606 (define-key map [remap move-end-of-line] 'markdown-end-of-line) 5607 ;; Paragraphs (Markdown context aware) 5608 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) 5609 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) 5610 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) 5611 ;; Blocks (one or more paragraphs) 5612 (define-key map (kbd "C-M-{") 'markdown-backward-block) 5613 (define-key map (kbd "C-M-}") 'markdown-forward-block) 5614 (define-key map (kbd "C-c M-h") 'markdown-mark-block) 5615 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) 5616 ;; Pages (top-level sections) 5617 (define-key map [remap backward-page] 'markdown-backward-page) 5618 (define-key map [remap forward-page] 'markdown-forward-page) 5619 (define-key map [remap mark-page] 'markdown-mark-page) 5620 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) 5621 ;; Link Movement 5622 (define-key map (kbd "M-n") 'markdown-next-link) 5623 (define-key map (kbd "M-p") 'markdown-previous-link) 5624 ;; Toggling functionality 5625 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) 5626 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) 5627 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) 5628 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) 5629 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) 5630 ;; Alternative keys (in case of problems with the arrow keys) 5631 (define-key map (kbd "C-c C-x u") 'markdown-move-up) 5632 (define-key map (kbd "C-c C-x d") 'markdown-move-down) 5633 (define-key map (kbd "C-c C-x l") 'markdown-promote) 5634 (define-key map (kbd "C-c C-x r") 'markdown-demote) 5635 ;; Deprecated keys that may be removed in a future version 5636 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l 5637 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l 5638 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l 5639 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l 5640 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) 5641 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) 5642 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) 5643 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) 5644 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) 5645 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) 5646 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) 5647 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) 5648 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) 5649 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) 5650 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) 5651 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) 5652 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) 5653 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) 5654 (define-key map (kbd "C-c C-i") 'markdown-insert-image) 5655 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j 5656 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d 5657 (define-key map (kbd "C-c -") 'markdown-insert-hr) 5658 map) 5659 "Keymap for Markdown major mode.") 5660 5661 (defvar markdown-mode-mouse-map 5662 (when markdown-mouse-follow-link 5663 (let ((map (make-sparse-keymap))) 5664 (define-key map [follow-link] 'mouse-face) 5665 (define-key map [mouse-2] #'markdown-follow-thing-at-point) 5666 map)) 5667 "Keymap for following links with mouse.") 5668 5669 (defvar gfm-mode-map 5670 (let ((map (make-sparse-keymap))) 5671 (set-keymap-parent map markdown-mode-map) 5672 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) 5673 (define-key map "`" 'markdown-electric-backquote) 5674 map) 5675 "Keymap for `gfm-mode'. 5676 See also `markdown-mode-map'.") 5677 5678 5679 ;;; Menu ====================================================================== 5680 5681 (easy-menu-define markdown-mode-menu markdown-mode-map 5682 "Menu for Markdown mode." 5683 '("Markdown" 5684 "---" 5685 ("Movement" 5686 ["Jump" markdown-do] 5687 ["Follow Link" markdown-follow-thing-at-point] 5688 ["Next Link" markdown-next-link] 5689 ["Previous Link" markdown-previous-link] 5690 "---" 5691 ["Next Heading or List Item" markdown-outline-next] 5692 ["Previous Heading or List Item" markdown-outline-previous] 5693 ["Next at Same Level" markdown-outline-next-same-level] 5694 ["Previous at Same Level" markdown-outline-previous-same-level] 5695 ["Up to Parent" markdown-outline-up] 5696 "---" 5697 ["Forward Paragraph" markdown-forward-paragraph] 5698 ["Backward Paragraph" markdown-backward-paragraph] 5699 ["Forward Block" markdown-forward-block] 5700 ["Backward Block" markdown-backward-block]) 5701 ("Show & Hide" 5702 ["Cycle Heading Visibility" markdown-cycle 5703 :enable (markdown-on-heading-p)] 5704 ["Cycle Heading Visibility (Global)" markdown-shifttab] 5705 "---" 5706 ["Narrow to Region" narrow-to-region] 5707 ["Narrow to Block" markdown-narrow-to-block] 5708 ["Narrow to Section" narrow-to-defun] 5709 ["Narrow to Subtree" markdown-narrow-to-subtree] 5710 ["Widen" widen (buffer-narrowed-p)] 5711 "---" 5712 ["Toggle Markup Hiding" markdown-toggle-markup-hiding 5713 :keys "C-c C-x C-m" 5714 :style radio 5715 :selected markdown-hide-markup]) 5716 "---" 5717 ("Headings & Structure" 5718 ["Automatic Heading" markdown-insert-header-dwim 5719 :keys "C-c C-s h"] 5720 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim 5721 :keys "C-c C-s H"] 5722 ("Specific Heading (atx)" 5723 ["First Level atx" markdown-insert-header-atx-1 5724 :keys "C-c C-s 1"] 5725 ["Second Level atx" markdown-insert-header-atx-2 5726 :keys "C-c C-s 2"] 5727 ["Third Level atx" markdown-insert-header-atx-3 5728 :keys "C-c C-s 3"] 5729 ["Fourth Level atx" markdown-insert-header-atx-4 5730 :keys "C-c C-s 4"] 5731 ["Fifth Level atx" markdown-insert-header-atx-5 5732 :keys "C-c C-s 5"] 5733 ["Sixth Level atx" markdown-insert-header-atx-6 5734 :keys "C-c C-s 6"]) 5735 ("Specific Heading (Setext)" 5736 ["First Level Setext" markdown-insert-header-setext-1 5737 :keys "C-c C-s !"] 5738 ["Second Level Setext" markdown-insert-header-setext-2 5739 :keys "C-c C-s @"]) 5740 ["Horizontal Rule" markdown-insert-hr 5741 :keys "C-c C-s -"] 5742 "---" 5743 ["Move Subtree Up" markdown-move-up 5744 :keys "C-c <up>"] 5745 ["Move Subtree Down" markdown-move-down 5746 :keys "C-c <down>"] 5747 ["Promote Subtree" markdown-promote 5748 :keys "C-c <left>"] 5749 ["Demote Subtree" markdown-demote 5750 :keys "C-c <right>"]) 5751 ("Region & Mark" 5752 ["Indent Region" markdown-indent-region] 5753 ["Outdent Region" markdown-outdent-region] 5754 "--" 5755 ["Mark Paragraph" mark-paragraph] 5756 ["Mark Block" markdown-mark-block] 5757 ["Mark Section" mark-defun] 5758 ["Mark Subtree" markdown-mark-subtree]) 5759 ("Tables" 5760 ["Move Row Up" markdown-move-up 5761 :enable (markdown-table-at-point-p) 5762 :keys "C-c <up>"] 5763 ["Move Row Down" markdown-move-down 5764 :enable (markdown-table-at-point-p) 5765 :keys "C-c <down>"] 5766 ["Move Column Left" markdown-promote 5767 :enable (markdown-table-at-point-p) 5768 :keys "C-c <left>"] 5769 ["Move Column Right" markdown-demote 5770 :enable (markdown-table-at-point-p) 5771 :keys "C-c <right>"] 5772 ["Delete Row" markdown-table-delete-row 5773 :enable (markdown-table-at-point-p)] 5774 ["Insert Row" markdown-table-insert-row 5775 :enable (markdown-table-at-point-p)] 5776 ["Delete Column" markdown-table-delete-column 5777 :enable (markdown-table-at-point-p)] 5778 ["Insert Column" markdown-table-insert-column 5779 :enable (markdown-table-at-point-p)] 5780 ["Insert Table" markdown-insert-table] 5781 "--" 5782 ["Convert Region to Table" markdown-table-convert-region] 5783 ["Sort Table Lines" markdown-table-sort-lines 5784 :enable (markdown-table-at-point-p)] 5785 ["Transpose Table" markdown-table-transpose 5786 :enable (markdown-table-at-point-p)]) 5787 ("Lists" 5788 ["Insert List Item" markdown-insert-list-item] 5789 ["Move Subtree Up" markdown-move-up 5790 :keys "C-c <up>"] 5791 ["Move Subtree Down" markdown-move-down 5792 :keys "C-c <down>"] 5793 ["Indent Subtree" markdown-demote 5794 :keys "C-c <right>"] 5795 ["Outdent Subtree" markdown-promote 5796 :keys "C-c <left>"] 5797 ["Renumber List" markdown-cleanup-list-numbers] 5798 ["Insert Task List Item" markdown-insert-gfm-checkbox 5799 :keys "C-c C-x ["] 5800 ["Toggle Task List Item" markdown-toggle-gfm-checkbox 5801 :enable (markdown-gfm-task-list-item-at-point) 5802 :keys "C-c C-d"]) 5803 ("Links & Images" 5804 ["Insert Link" markdown-insert-link] 5805 ["Insert Image" markdown-insert-image] 5806 ["Insert Footnote" markdown-insert-footnote 5807 :keys "C-c C-s f"] 5808 ["Insert Wiki Link" markdown-insert-wiki-link 5809 :keys "C-c C-s w"] 5810 "---" 5811 ["Check References" markdown-check-refs] 5812 ["Find Unused References" markdown-unused-refs] 5813 ["Toggle URL Hiding" markdown-toggle-url-hiding 5814 :style radio 5815 :selected markdown-hide-urls] 5816 ["Toggle Inline Images" markdown-toggle-inline-images 5817 :keys "C-c C-x C-i" 5818 :style radio 5819 :selected markdown-inline-image-overlays] 5820 ["Toggle Wiki Links" markdown-toggle-wiki-links 5821 :style radio 5822 :selected markdown-enable-wiki-links]) 5823 ("Styles" 5824 ["Bold" markdown-insert-bold] 5825 ["Italic" markdown-insert-italic] 5826 ["Code" markdown-insert-code] 5827 ["Strikethrough" markdown-insert-strike-through] 5828 ["Keyboard" markdown-insert-kbd] 5829 "---" 5830 ["Blockquote" markdown-insert-blockquote] 5831 ["Preformatted" markdown-insert-pre] 5832 ["GFM Code Block" markdown-insert-gfm-code-block] 5833 ["Edit Code Block" markdown-edit-code-block 5834 :enable (markdown-code-block-at-point-p)] 5835 ["Foldable Block" markdown-insert-foldable-block] 5836 "---" 5837 ["Blockquote Region" markdown-blockquote-region] 5838 ["Preformatted Region" markdown-pre-region] 5839 "---" 5840 ["Fontify Code Blocks Natively" 5841 markdown-toggle-fontify-code-blocks-natively 5842 :style radio 5843 :selected markdown-fontify-code-blocks-natively] 5844 ["LaTeX Math Support" markdown-toggle-math 5845 :style radio 5846 :selected markdown-enable-math]) 5847 "---" 5848 ("Preview & Export" 5849 ["Compile" markdown-other-window] 5850 ["Preview" markdown-preview] 5851 ["Export" markdown-export] 5852 ["Export & View" markdown-export-and-preview] 5853 ["Open" markdown-open] 5854 ["Live Export" markdown-live-preview-mode 5855 :style radio 5856 :selected markdown-live-preview-mode] 5857 ["Kill ring save" markdown-kill-ring-save]) 5858 ("Markup Completion and Cycling" 5859 ["Complete Markup" markdown-complete] 5860 ["Promote Element" markdown-promote 5861 :keys "C-c C--"] 5862 ["Demote Element" markdown-demote 5863 :keys "C-c C-="]) 5864 "---" 5865 ["Kill Element" markdown-kill-thing-at-point] 5866 "---" 5867 ("Documentation" 5868 ["Version" markdown-show-version] 5869 ["Homepage" markdown-mode-info] 5870 ["Describe Mode" (describe-function 'markdown-mode)] 5871 ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) 5872 5873 5874 ;;; imenu ===================================================================== 5875 5876 (defun markdown-imenu-create-nested-index () 5877 "Create and return a nested imenu index alist for the current buffer. 5878 See `imenu-create-index-function' and `imenu--index-alist' for details." 5879 (let* ((root (list nil)) 5880 (min-level 9999) 5881 hashes headers) 5882 (save-excursion 5883 ;; Headings 5884 (goto-char (point-min)) 5885 (while (re-search-forward markdown-regex-header (point-max) t) 5886 (unless (or (markdown-code-block-at-point-p) 5887 (and (match-beginning 3) 5888 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) 5889 (cond 5890 ((match-string-no-properties 2) ;; level 1 setext 5891 (setq min-level 1) 5892 (push (list :heading (match-string-no-properties 1) 5893 :point (match-beginning 1) 5894 :level 1) headers)) 5895 ((match-string-no-properties 3) ;; level 2 setext 5896 (setq min-level (min min-level 2)) 5897 (push (list :heading (match-string-no-properties 1) 5898 :point (match-beginning 1) 5899 :level (- 2 (1- min-level))) headers)) 5900 ((setq hashes (markdown-trim-whitespace 5901 (match-string-no-properties 4))) 5902 (setq min-level (min min-level (length hashes))) 5903 (push (list :heading (match-string-no-properties 5) 5904 :point (match-beginning 4) 5905 :level (- (length hashes) (1- min-level))) headers))))) 5906 (cl-loop with cur-level = 0 5907 with cur-alist = nil 5908 with empty-heading = "-" 5909 with self-heading = "." 5910 for header in (reverse headers) 5911 for level = (plist-get header :level) 5912 do 5913 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) 5914 (cond 5915 ((= cur-level level) ; new sibling 5916 (setcdr cur-alist alist) 5917 (setq cur-alist alist)) 5918 ((< cur-level level) ; first child 5919 (dotimes (_ (- level cur-level 1)) 5920 (setq alist (list (cons empty-heading alist)))) 5921 (if cur-alist 5922 (let* ((parent (car cur-alist)) 5923 (self-pos (cdr parent))) 5924 (setcdr parent (cons (cons self-heading self-pos) alist))) 5925 (setcdr root alist)) ; primogenitor 5926 (setq cur-alist alist) 5927 (setq cur-level level)) 5928 (t ; new sibling of an ancestor 5929 (let ((sibling-alist (last (cdr root)))) 5930 (dotimes (_ (1- level)) 5931 (setq sibling-alist (last (cdar sibling-alist)))) 5932 (setcdr sibling-alist alist) 5933 (setq cur-alist alist)) 5934 (setq cur-level level))))) 5935 (setq root (copy-tree root)) 5936 ;; Footnotes 5937 (let ((fn (markdown-get-defined-footnotes))) 5938 (if (or (zerop (length fn)) 5939 (null markdown-add-footnotes-to-imenu)) 5940 (cdr root) 5941 (nconc (cdr root) (list (cons "Footnotes" fn)))))))) 5942 5943 (defun markdown-imenu-create-flat-index () 5944 "Create and return a flat imenu index alist for the current buffer. 5945 See `imenu-create-index-function' and `imenu--index-alist' for details." 5946 (let* ((empty-heading "-") index heading pos) 5947 (save-excursion 5948 ;; Headings 5949 (goto-char (point-min)) 5950 (while (re-search-forward markdown-regex-header (point-max) t) 5951 (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) 5952 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) 5953 (cond 5954 ((setq heading (match-string-no-properties 1)) 5955 (setq pos (match-beginning 1))) 5956 ((setq heading (match-string-no-properties 5)) 5957 (setq pos (match-beginning 4)))) 5958 (or (> (length heading) 0) 5959 (setq heading empty-heading)) 5960 (setq index (append index (list (cons heading pos)))))) 5961 ;; Footnotes 5962 (when markdown-add-footnotes-to-imenu 5963 (nconc index (markdown-get-defined-footnotes))) 5964 index))) 5965 5966 5967 ;;; References ================================================================ 5968 5969 (defun markdown-reference-goto-definition () 5970 "Jump to the definition of the reference at point or create it." 5971 (interactive) 5972 (when (thing-at-point-looking-at markdown-regex-link-reference) 5973 (let* ((text (match-string-no-properties 3)) 5974 (reference (match-string-no-properties 6)) 5975 (target (downcase (if (string= reference "") text reference))) 5976 (loc (cadr (save-match-data (markdown-reference-definition target))))) 5977 (if loc 5978 (goto-char loc) 5979 (goto-char (match-beginning 0)) 5980 (markdown-insert-reference-definition target))))) 5981 5982 (defun markdown-reference-find-links (reference) 5983 "Return a list of all links for REFERENCE. 5984 REFERENCE should not include the surrounding square brackets. 5985 Elements of the list have the form (text start line), where 5986 text is the link text, start is the location at the beginning of 5987 the link, and line is the line number on which the link appears." 5988 (let* ((ref-quote (regexp-quote reference)) 5989 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" 5990 ref-quote ref-quote)) 5991 links) 5992 (save-excursion 5993 (goto-char (point-min)) 5994 (while (re-search-forward regexp nil t) 5995 (let* ((text (or (match-string-no-properties 1) 5996 (match-string-no-properties 2))) 5997 (start (match-beginning 0)) 5998 (line (markdown-line-number-at-pos))) 5999 (cl-pushnew (list text start line) links :test #'equal)))) 6000 links)) 6001 6002 (defmacro markdown-for-all-refs (f) 6003 `(let ((result)) 6004 (save-excursion 6005 (goto-char (point-min)) 6006 (while 6007 (re-search-forward markdown-regex-link-reference nil t) 6008 (let* ((text (match-string-no-properties 3)) 6009 (reference (match-string-no-properties 6)) 6010 (target (downcase (if (string= reference "") text reference)))) 6011 (,f text target result)))) 6012 (reverse result))) 6013 6014 (defmacro markdown-collect-always (_ target result) 6015 `(cl-pushnew ,target ,result :test #'equal)) 6016 6017 (defmacro markdown-collect-undefined (text target result) 6018 `(unless (markdown-reference-definition target) 6019 (let ((entry (assoc ,target ,result))) 6020 (if (not entry) 6021 (cl-pushnew 6022 (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) 6023 ,result :test #'equal) 6024 (setcdr entry 6025 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) 6026 6027 (defun markdown-get-all-refs () 6028 "Return a list of all Markdown references." 6029 (markdown-for-all-refs markdown-collect-always)) 6030 6031 (defun markdown-get-undefined-refs () 6032 "Return a list of undefined Markdown references. 6033 Result is an alist of pairs (reference . occurrences), where 6034 occurrences is itself another alist of pairs (label . line-number). 6035 For example, an alist corresponding to [Nice editor][Emacs] at line 12, 6036 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is 6037 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." 6038 (markdown-for-all-refs markdown-collect-undefined)) 6039 6040 (defun markdown-get-unused-refs () 6041 (cl-sort 6042 (cl-set-difference 6043 (markdown-get-defined-references) (markdown-get-all-refs) 6044 :test (lambda (e1 e2) (equal (car e1) e2))) 6045 #'< :key #'cdr)) 6046 6047 (defmacro defun-markdown-buffer (name docstring) 6048 "Define a function to name and return a buffer. 6049 6050 By convention, NAME must be a name of a string constant with 6051 %buffer% placeholder used to name the buffer, and will also be 6052 used as a name of the function defined. 6053 6054 DOCSTRING will be used as the first part of the docstring." 6055 `(defun ,name (&optional buffer-name) 6056 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") 6057 (or buffer-name (setq buffer-name (buffer-name))) 6058 (let ((refbuf (get-buffer-create (replace-regexp-in-string 6059 "%buffer%" buffer-name 6060 ,name)))) 6061 (with-current-buffer refbuf 6062 (when view-mode 6063 (View-exit-and-edit)) 6064 (use-local-map button-buffer-map) 6065 (erase-buffer)) 6066 refbuf))) 6067 6068 (defconst markdown-reference-check-buffer 6069 "*Undefined references for %buffer%*" 6070 "Pattern for name of buffer for listing undefined references. 6071 The string %buffer% will be replaced by the corresponding 6072 `markdown-mode' buffer name.") 6073 6074 (defun-markdown-buffer 6075 markdown-reference-check-buffer 6076 "Name and return buffer for reference checking.") 6077 6078 (defconst markdown-unused-references-buffer 6079 "*Unused references for %buffer%*" 6080 "Pattern for name of buffer for listing unused references. 6081 The string %buffer% will be replaced by the corresponding 6082 `markdown-mode' buffer name.") 6083 6084 (defun-markdown-buffer 6085 markdown-unused-references-buffer 6086 "Name and return buffer for unused reference checking.") 6087 6088 (defconst markdown-reference-links-buffer 6089 "*Reference links for %buffer%*" 6090 "Pattern for name of buffer for listing references. 6091 The string %buffer% will be replaced by the corresponding buffer name.") 6092 6093 (defun-markdown-buffer 6094 markdown-reference-links-buffer 6095 "Name, setup, and return a buffer for listing links.") 6096 6097 ;; Add an empty Markdown reference definition to buffer 6098 ;; specified in the 'target-buffer property. The reference name is 6099 ;; the button's label. 6100 (define-button-type 'markdown-undefined-reference-button 6101 'help-echo "mouse-1, RET: create definition for undefined reference" 6102 'follow-link t 6103 'face 'bold 6104 'action (lambda (b) 6105 (let ((buffer (button-get b 'target-buffer)) 6106 (line (button-get b 'target-line)) 6107 (label (button-label b))) 6108 (switch-to-buffer-other-window buffer) 6109 (goto-char (point-min)) 6110 (forward-line line) 6111 (markdown-insert-reference-definition label) 6112 (markdown-check-refs t)))) 6113 6114 ;; Jump to line in buffer specified by 'target-buffer property. 6115 ;; Line number is button's 'target-line property. 6116 (define-button-type 'markdown-goto-line-button 6117 'help-echo "mouse-1, RET: go to line" 6118 'follow-link t 6119 'face 'italic 6120 'action (lambda (b) 6121 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6122 ;; use call-interactively to silence compiler 6123 (let ((current-prefix-arg (button-get b 'target-line))) 6124 (call-interactively 'goto-line)))) 6125 6126 ;; Kill a line in buffer specified by 'target-buffer property. 6127 ;; Line number is button's 'target-line property. 6128 (define-button-type 'markdown-kill-line-button 6129 'help-echo "mouse-1, RET: kill line" 6130 'follow-link t 6131 'face 'italic 6132 'action (lambda (b) 6133 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6134 ;; use call-interactively to silence compiler 6135 (let ((current-prefix-arg (button-get b 'target-line))) 6136 (call-interactively 'goto-line)) 6137 (kill-line 1) 6138 (markdown-unused-refs t))) 6139 6140 ;; Jumps to a particular link at location given by 'target-char 6141 ;; property in buffer given by 'target-buffer property. 6142 (define-button-type 'markdown-location-button 6143 'help-echo "mouse-1, RET: jump to location of link" 6144 'follow-link t 6145 'face 'bold 6146 'action (lambda (b) 6147 (let ((target (button-get b 'target-buffer)) 6148 (loc (button-get b 'target-char))) 6149 (kill-buffer-and-window) 6150 (switch-to-buffer target) 6151 (goto-char loc)))) 6152 6153 (defun markdown-insert-undefined-reference-button (reference oldbuf) 6154 "Insert a button for creating REFERENCE in buffer OLDBUF. 6155 REFERENCE should be a list of the form (reference . occurrences), 6156 as returned by `markdown-get-undefined-refs'." 6157 (let ((label (car reference))) 6158 ;; Create a reference button 6159 (insert-button label 6160 :type 'markdown-undefined-reference-button 6161 'target-buffer oldbuf 6162 'target-line (cdr (car (cdr reference)))) 6163 (insert " (") 6164 (dolist (occurrence (cdr reference)) 6165 (let ((line (cdr occurrence))) 6166 ;; Create a line number button 6167 (insert-button (number-to-string line) 6168 :type 'markdown-goto-line-button 6169 'target-buffer oldbuf 6170 'target-line line) 6171 (insert " "))) 6172 (delete-char -1) 6173 (insert ")") 6174 (newline))) 6175 6176 (defun markdown-insert-unused-reference-button (reference oldbuf) 6177 "Insert a button for creating REFERENCE in buffer OLDBUF. 6178 REFERENCE must be a pair of (ref . line-number)." 6179 (let ((label (car reference)) 6180 (line (cdr reference))) 6181 ;; Create a reference button 6182 (insert-button label 6183 :type 'markdown-goto-line-button 6184 'face 'bold 6185 'target-buffer oldbuf 6186 'target-line line) 6187 (insert (format " (%d) [" line)) 6188 (insert-button "X" 6189 :type 'markdown-kill-line-button 6190 'face 'bold 6191 'target-buffer oldbuf 6192 'target-line line) 6193 (insert "]") 6194 (newline))) 6195 6196 (defun markdown-insert-link-button (link oldbuf) 6197 "Insert a button for jumping to LINK in buffer OLDBUF. 6198 LINK should be a list of the form (text char line) containing 6199 the link text, location, and line number." 6200 (let ((label (cl-first link)) 6201 (char (cl-second link)) 6202 (line (cl-third link))) 6203 ;; Create a reference button 6204 (insert-button label 6205 :type 'markdown-location-button 6206 'target-buffer oldbuf 6207 'target-char char) 6208 (insert (format " (line %d)\n" line)))) 6209 6210 (defun markdown-reference-goto-link (&optional reference) 6211 "Jump to the location of the first use of REFERENCE." 6212 (interactive) 6213 (unless reference 6214 (if (thing-at-point-looking-at markdown-regex-reference-definition) 6215 (setq reference (match-string-no-properties 2)) 6216 (user-error "No reference definition at point"))) 6217 (let ((links (markdown-reference-find-links reference))) 6218 (cond ((= (length links) 1) 6219 (goto-char (cadr (car links)))) 6220 ((> (length links) 1) 6221 (let ((oldbuf (current-buffer)) 6222 (linkbuf (markdown-reference-links-buffer))) 6223 (with-current-buffer linkbuf 6224 (insert "Links using reference " reference ":\n\n") 6225 (dolist (link (reverse links)) 6226 (markdown-insert-link-button link oldbuf))) 6227 (view-buffer-other-window linkbuf) 6228 (goto-char (point-min)) 6229 (forward-line 2))) 6230 (t 6231 (error "No links for reference %s" reference))))) 6232 6233 (defmacro defun-markdown-ref-checker 6234 (name docstring checker-function buffer-function none-message buffer-header insert-reference) 6235 "Define a function NAME acting on result of CHECKER-FUNCTION. 6236 6237 DOCSTRING is used as a docstring for the defined function. 6238 6239 BUFFER-FUNCTION should name and return an auxiliary buffer to put 6240 results in. 6241 6242 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. 6243 6244 BUFFER-HEADER is put into the auxiliary buffer first, followed by 6245 calling INSERT-REFERENCE for each element in the list returned by 6246 CHECKER-FUNCTION." 6247 `(defun ,name (&optional silent) 6248 ,(concat 6249 docstring 6250 "\n\nIf SILENT is non-nil, do not message anything when no 6251 such references found.") 6252 (interactive "P") 6253 (unless (derived-mode-p 'markdown-mode) 6254 (user-error "Not available in current mode")) 6255 (let ((oldbuf (current-buffer)) 6256 (refs (,checker-function)) 6257 (refbuf (,buffer-function))) 6258 (if (null refs) 6259 (progn 6260 (when (not silent) 6261 (message ,none-message)) 6262 (kill-buffer refbuf)) 6263 (with-current-buffer refbuf 6264 (insert ,buffer-header) 6265 (dolist (ref refs) 6266 (,insert-reference ref oldbuf)) 6267 (view-buffer-other-window refbuf) 6268 (goto-char (point-min)) 6269 (forward-line 2)))))) 6270 6271 (defun-markdown-ref-checker 6272 markdown-check-refs 6273 "Show all undefined Markdown references in current `markdown-mode' buffer. 6274 6275 Links which have empty reference definitions are considered to be 6276 defined." 6277 markdown-get-undefined-refs 6278 markdown-reference-check-buffer 6279 "No undefined references found" 6280 "The following references are undefined:\n\n" 6281 markdown-insert-undefined-reference-button) 6282 6283 6284 (defun-markdown-ref-checker 6285 markdown-unused-refs 6286 "Show all unused Markdown references in current `markdown-mode' buffer." 6287 markdown-get-unused-refs 6288 markdown-unused-references-buffer 6289 "No unused references found" 6290 "The following references are unused:\n\n" 6291 markdown-insert-unused-reference-button) 6292 6293 6294 6295 ;;; Lists ===================================================================== 6296 6297 (defun markdown-insert-list-item (&optional arg) 6298 "Insert a new list item. 6299 If the point is inside unordered list, insert a bullet mark. If 6300 the point is inside ordered list, insert the next number followed 6301 by a period. Use the previous list item to determine the amount 6302 of whitespace to place before and after list markers. 6303 6304 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 6305 decrease the indentation by one level. 6306 6307 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 6308 increase the indentation by one level." 6309 (interactive "p") 6310 (let (bounds cur-indent marker indent new-indent new-loc) 6311 (save-match-data 6312 ;; Look for a list item on current or previous non-blank line 6313 (save-excursion 6314 (while (and (not (setq bounds (markdown-cur-list-item-bounds))) 6315 (not (bobp)) 6316 (markdown-cur-line-blank-p)) 6317 (forward-line -1))) 6318 (when bounds 6319 (cond ((save-excursion 6320 (skip-chars-backward " \t") 6321 (looking-at-p markdown-regex-list)) 6322 (beginning-of-line) 6323 (insert "\n") 6324 (forward-line -1)) 6325 ((not (markdown-cur-line-blank-p)) 6326 (newline))) 6327 (setq new-loc (point))) 6328 ;; Look ahead for a list item on next non-blank line 6329 (unless bounds 6330 (save-excursion 6331 (while (and (null bounds) 6332 (not (eobp)) 6333 (markdown-cur-line-blank-p)) 6334 (forward-line) 6335 (setq bounds (markdown-cur-list-item-bounds)))) 6336 (when bounds 6337 (setq new-loc (point)) 6338 (unless (markdown-cur-line-blank-p) 6339 (newline)))) 6340 (if (not bounds) 6341 ;; When not in a list, start a new unordered one 6342 (progn 6343 (unless (markdown-cur-line-blank-p) 6344 (insert "\n")) 6345 (insert markdown-unordered-list-item-prefix)) 6346 ;; Compute indentation and marker for new list item 6347 (setq cur-indent (nth 2 bounds)) 6348 (setq marker (nth 4 bounds)) 6349 ;; If current item is a GFM checkbox, insert new unchecked checkbox. 6350 (when (nth 5 bounds) 6351 (setq marker 6352 (concat marker 6353 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) 6354 (cond 6355 ;; Dedent: decrement indentation, find previous marker. 6356 ((= arg 4) 6357 (setq indent (max (- cur-indent markdown-list-indent-width) 0)) 6358 (let ((prev-bounds 6359 (save-excursion 6360 (goto-char (nth 0 bounds)) 6361 (when (markdown-up-list) 6362 (markdown-cur-list-item-bounds))))) 6363 (when prev-bounds 6364 (setq marker (nth 4 prev-bounds))))) 6365 ;; Indent: increment indentation by 4, use same marker. 6366 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) 6367 ;; Same level: keep current indentation and marker. 6368 (t (setq indent cur-indent))) 6369 (setq new-indent (make-string indent 32)) 6370 (goto-char new-loc) 6371 (cond 6372 ;; Ordered list 6373 ((string-match-p "[0-9]" marker) 6374 (if (= arg 16) ;; starting a new column indented one more level 6375 (insert (concat new-indent "1. ")) 6376 ;; Don't use previous match-data 6377 (set-match-data nil) 6378 ;; travel up to the last item and pick the correct number. If 6379 ;; the argument was nil, "new-indent = cur-indent" is the same, 6380 ;; so we don't need special treatment. Neat. 6381 (save-excursion 6382 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) 6383 (>= (forward-line -1) 0)))) 6384 (let* ((old-prefix (match-string 1)) 6385 (old-spacing (match-string 2)) 6386 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) 6387 (int-to-string (1+ (string-to-number old-prefix))) 6388 "1")) 6389 (space-adjust (- (length old-prefix) (length new-prefix))) 6390 (new-spacing (if (and (match-string 2) 6391 (not (string-match-p "\t" old-spacing)) 6392 (< space-adjust 0) 6393 (> space-adjust (- 1 (length (match-string 2))))) 6394 (substring (match-string 2) 0 space-adjust) 6395 (or old-spacing ". ")))) 6396 (insert (concat new-indent new-prefix new-spacing))))) 6397 ;; Unordered list, GFM task list, or ordered list with hash mark 6398 ((string-match-p "[\\*\\+-]\\|#\\." marker) 6399 (insert new-indent marker)))) 6400 ;; Propertize the newly inserted list item now 6401 (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) 6402 6403 (defun markdown-move-list-item-up () 6404 "Move the current list item up in the list when possible. 6405 In nested lists, move child items with the parent item." 6406 (interactive) 6407 (let (cur prev old) 6408 (when (setq cur (markdown-cur-list-item-bounds)) 6409 (setq old (point)) 6410 (goto-char (nth 0 cur)) 6411 (if (markdown-prev-list-item (nth 3 cur)) 6412 (progn 6413 (setq prev (markdown-cur-list-item-bounds)) 6414 (condition-case nil 6415 (progn 6416 (transpose-regions (nth 0 prev) (nth 1 prev) 6417 (nth 0 cur) (nth 1 cur) t) 6418 (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) 6419 ;; Catch error in case regions overlap. 6420 (error (goto-char old)))) 6421 (goto-char old))))) 6422 6423 (defun markdown-move-list-item-down () 6424 "Move the current list item down in the list when possible. 6425 In nested lists, move child items with the parent item." 6426 (interactive) 6427 (let (cur next old) 6428 (when (setq cur (markdown-cur-list-item-bounds)) 6429 (setq old (point)) 6430 (if (markdown-next-list-item (nth 3 cur)) 6431 (progn 6432 (setq next (markdown-cur-list-item-bounds)) 6433 (condition-case nil 6434 (progn 6435 (transpose-regions (nth 0 cur) (nth 1 cur) 6436 (nth 0 next) (nth 1 next) nil) 6437 (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) 6438 ;; Catch error in case regions overlap. 6439 (error (goto-char old)))) 6440 (goto-char old))))) 6441 6442 (defun markdown-demote-list-item (&optional bounds) 6443 "Indent (or demote) the current list item. 6444 Optionally, BOUNDS of the current list item may be provided if available. 6445 In nested lists, demote child items as well." 6446 (interactive) 6447 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6448 (save-excursion 6449 (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) 6450 (item-end (set-marker (make-marker) (nth 1 bounds))) 6451 (list-start (progn (markdown-beginning-of-list) 6452 (set-marker (make-marker) (point)))) 6453 (list-end (progn (markdown-end-of-list) 6454 (set-marker (make-marker) (point))))) 6455 (goto-char item-start) 6456 (while (< (point) item-end) 6457 (unless (markdown-cur-line-blank-p) 6458 (insert (make-string markdown-list-indent-width ? ))) 6459 (forward-line)) 6460 (markdown-syntax-propertize-list-items list-start list-end))))) 6461 6462 (defun markdown-promote-list-item (&optional bounds) 6463 "Unindent (or promote) the current list item. 6464 Optionally, BOUNDS of the current list item may be provided if available. 6465 In nested lists, demote child items as well." 6466 (interactive) 6467 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6468 (save-excursion 6469 (save-match-data 6470 (let ((item-start (set-marker (make-marker) (nth 0 bounds))) 6471 (item-end (set-marker (make-marker) (nth 1 bounds))) 6472 (list-start (progn (markdown-beginning-of-list) 6473 (set-marker (make-marker) (point)))) 6474 (list-end (progn (markdown-end-of-list) 6475 (set-marker (make-marker) (point)))) 6476 num regexp) 6477 (goto-char item-start) 6478 (when (looking-at (format "^[ ]\\{1,%d\\}" 6479 markdown-list-indent-width)) 6480 (setq num (- (match-end 0) (match-beginning 0))) 6481 (setq regexp (format "^[ ]\\{1,%d\\}" num)) 6482 (while (and (< (point) item-end) 6483 (re-search-forward regexp item-end t)) 6484 (replace-match "" nil nil) 6485 (forward-line)) 6486 (markdown-syntax-propertize-list-items list-start list-end))))))) 6487 6488 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) 6489 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. 6490 PREV-ITEM is width of previous-indentation and list number 6491 6492 Assume that the previously found match was for a numbered item in 6493 a list." 6494 (let ((cpfx pfx) 6495 (cur-item nil) 6496 (idx 0) 6497 (continue t) 6498 (step t) 6499 (sep nil)) 6500 (while (and continue (not (eobp))) 6501 (setq step t) 6502 (cond 6503 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") 6504 (setq cpfx (match-string-no-properties 2)) 6505 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker 6506 (cond 6507 ((or (= (length cpfx) (length pfx)) 6508 (= (length cur-item) (length prev-item))) 6509 (save-excursion 6510 (replace-match 6511 (if (not markdown-ordered-list-enumeration) 6512 (concat pfx "1. ") 6513 (cl-incf idx) 6514 (concat pfx (number-to-string idx) ". ")))) 6515 (setq sep nil)) 6516 ;; indented a level 6517 ((< (length pfx) (length cpfx)) 6518 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) 6519 (setq step nil)) 6520 ;; exit the loop 6521 (t 6522 (setq step nil) 6523 (setq continue nil)))) 6524 6525 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") 6526 (setq cpfx (match-string-no-properties 1)) 6527 (cond 6528 ;; reset if separated before 6529 ((string= cpfx pfx) (when sep (setq idx 0))) 6530 ((string< cpfx pfx) 6531 (setq step nil) 6532 (setq continue nil)))) 6533 (t (setq sep t))) 6534 6535 (when step 6536 (beginning-of-line) 6537 (setq continue (= (forward-line) 0)))) 6538 sep)) 6539 6540 (defun markdown-cleanup-list-numbers () 6541 "Update the numbering of ordered lists." 6542 (interactive) 6543 (save-excursion 6544 (goto-char (point-min)) 6545 (markdown-cleanup-list-numbers-level ""))) 6546 6547 6548 ;;; Movement ================================================================== 6549 6550 ;; This function was originally derived from `org-beginning-of-line' from org.el. 6551 (defun markdown-beginning-of-line (&optional n) 6552 "Go to the beginning of the current visible line. 6553 6554 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6555 or symbol `reversed', on the first attempt move to where the 6556 headline text hashes, and only move to beginning of line when the 6557 cursor is already before the hashes of the text of the headline. 6558 6559 If `markdown-special-ctrl-a/e' is symbol `reversed' then go to 6560 the hashes of the text on the second attempt. 6561 6562 With argument N not nil or 1, move forward N - 1 lines first." 6563 (interactive "^p") 6564 (let ((origin (point)) 6565 (special (pcase markdown-special-ctrl-a/e 6566 (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) 6567 deactivate-mark) 6568 ;; First move to a visible line. 6569 (if visual-line-mode 6570 (beginning-of-visual-line n) 6571 (move-beginning-of-line n) 6572 ;; `move-beginning-of-line' may leave point after invisible 6573 ;; characters if line starts with such of these (e.g., with 6574 ;; a link at column 0). Really move to the beginning of the 6575 ;; current visible line. 6576 (forward-line 0)) 6577 (cond 6578 ;; No special behavior. Point is already at the beginning of 6579 ;; a line, logical or visual. 6580 ((not special)) 6581 ;; `beginning-of-visual-line' left point before logical beginning 6582 ;; of line: point is at the beginning of a visual line. Bail 6583 ;; out. 6584 ((and visual-line-mode (not (bolp)))) 6585 ((looking-at markdown-regex-header-atx) 6586 ;; At a header, special position is before the title. 6587 (let ((refpos (match-beginning 2)) 6588 (bol (point))) 6589 (if (eq special 'reversed) 6590 (when (and (= origin bol) (eq last-command this-command)) 6591 (goto-char refpos)) 6592 (when (or (> origin refpos) (<= origin bol)) 6593 (goto-char refpos))) 6594 ;; Prevent automatic cursor movement caused by the command loop. 6595 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6596 (when (and markdown-hide-markup 6597 (equal (get-char-property (point) 'display) "")) 6598 (setq disable-point-adjustment t)))) 6599 ((looking-at markdown-regex-list) 6600 ;; At a list item, special position is after the list marker or checkbox. 6601 (let ((refpos (or (match-end 4) (match-end 3)))) 6602 (if (eq special 'reversed) 6603 (when (and (= (point) origin) (eq last-command this-command)) 6604 (goto-char refpos)) 6605 (when (or (> origin refpos) (<= origin (line-beginning-position))) 6606 (goto-char refpos))))) 6607 ;; No special case, already at beginning of line. 6608 (t nil)))) 6609 6610 ;; This function was originally derived from `org-end-of-line' from org.el. 6611 (defun markdown-end-of-line (&optional n) 6612 "Go to the end of the line, but before ellipsis, if any. 6613 6614 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6615 or symbol `reversed', ignore closing tags on the first attempt, 6616 and only move to after the closing tags when the cursor is 6617 already beyond the end of the headline. 6618 6619 If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore 6620 closing tags on the second attempt. 6621 6622 With argument N not nil or 1, move forward N - 1 lines first." 6623 (interactive "^p") 6624 (let ((origin (point)) 6625 (special (pcase markdown-special-ctrl-a/e 6626 (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) 6627 deactivate-mark) 6628 ;; First move to a visible line. 6629 (if visual-line-mode 6630 (beginning-of-visual-line n) 6631 (move-beginning-of-line n)) 6632 (cond 6633 ;; At a headline, with closing tags. 6634 ((save-excursion 6635 (forward-line 0) 6636 (and (looking-at markdown-regex-header-atx) (match-end 3))) 6637 (let ((refpos (match-end 2)) 6638 (visual-end (and visual-line-mode 6639 (save-excursion 6640 (end-of-visual-line) 6641 (point))))) 6642 ;; If `end-of-visual-line' brings us before end of line or even closing 6643 ;; tags, i.e., the headline spans over multiple visual lines, move 6644 ;; there. 6645 (cond ((and visual-end 6646 (< visual-end refpos) 6647 (<= origin visual-end)) 6648 (goto-char visual-end)) 6649 ((not special) (end-of-line)) 6650 ((eq special 'reversed) 6651 (if (and (= origin (line-end-position)) 6652 (eq this-command last-command)) 6653 (goto-char refpos) 6654 (end-of-line))) 6655 (t 6656 (if (or (< origin refpos) (>= origin (line-end-position))) 6657 (goto-char refpos) 6658 (end-of-line)))) 6659 ;; Prevent automatic cursor movement caused by the command loop. 6660 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6661 (when (and markdown-hide-markup 6662 (equal (get-char-property (point) 'display) "")) 6663 (setq disable-point-adjustment t)))) 6664 (visual-line-mode 6665 (let ((bol (line-beginning-position))) 6666 (end-of-visual-line) 6667 ;; If `end-of-visual-line' gets us past the ellipsis at the 6668 ;; end of a line, backtrack and use `end-of-line' instead. 6669 (when (/= bol (line-beginning-position)) 6670 (goto-char bol) 6671 (end-of-line)))) 6672 (t (end-of-line))))) 6673 6674 (defun markdown-beginning-of-defun (&optional arg) 6675 "`beginning-of-defun-function' for Markdown. 6676 This is used to find the beginning of the defun and should behave 6677 like ‘beginning-of-defun’, returning non-nil if it found the 6678 beginning of a defun. It moves the point backward, right before a 6679 heading which defines a defun. When ARG is non-nil, repeat that 6680 many times. When ARG is negative, move forward to the ARG-th 6681 following section." 6682 (or arg (setq arg 1)) 6683 (when (< arg 0) (end-of-line)) 6684 ;; Adjust position for setext headings. 6685 (when (and (thing-at-point-looking-at markdown-regex-header-setext) 6686 (not (= (point) (match-beginning 0))) 6687 (not (markdown-code-block-at-point-p))) 6688 (goto-char (match-end 0))) 6689 (let (found) 6690 ;; Move backward with positive argument. 6691 (while (and (not (bobp)) (> arg 0)) 6692 (setq found nil) 6693 (while (and (not found) 6694 (not (bobp)) 6695 (re-search-backward markdown-regex-header nil 'move)) 6696 (markdown-code-block-at-pos (match-beginning 0)) 6697 (setq found (match-beginning 0))) 6698 (setq arg (1- arg))) 6699 ;; Move forward with negative argument. 6700 (while (and (not (eobp)) (< arg 0)) 6701 (setq found nil) 6702 (while (and (not found) 6703 (not (eobp)) 6704 (re-search-forward markdown-regex-header nil 'move)) 6705 (markdown-code-block-at-pos (match-beginning 0)) 6706 (setq found (match-beginning 0))) 6707 (setq arg (1+ arg))) 6708 (when found 6709 (beginning-of-line) 6710 t))) 6711 6712 (defun markdown-end-of-defun () 6713 "`end-of-defun-function’ for Markdown. 6714 This is used to find the end of the defun at point. 6715 It is called with no argument, right after calling ‘beginning-of-defun-raw’, 6716 so it can assume that point is at the beginning of the defun body. 6717 It should move point to the first position after the defun." 6718 (or (eobp) (forward-char 1)) 6719 (let (found) 6720 (while (and (not found) 6721 (not (eobp)) 6722 (re-search-forward markdown-regex-header nil 'move)) 6723 (when (not (markdown-code-block-at-pos (match-beginning 0))) 6724 (setq found (match-beginning 0)))) 6725 (when found 6726 (goto-char found) 6727 (skip-syntax-backward "-")))) 6728 6729 (defun markdown-beginning-of-text-block () 6730 "Move backward to previous beginning of a plain text block. 6731 This function simply looks for blank lines without considering 6732 the surrounding context in light of Markdown syntax. For that, see 6733 `markdown-backward-block'." 6734 (interactive) 6735 (let ((start (point))) 6736 (if (re-search-backward markdown-regex-block-separator nil t) 6737 (goto-char (match-end 0)) 6738 (goto-char (point-min))) 6739 (when (and (= start (point)) (not (bobp))) 6740 (forward-line -1) 6741 (if (re-search-backward markdown-regex-block-separator nil t) 6742 (goto-char (match-end 0)) 6743 (goto-char (point-min)))))) 6744 6745 (defun markdown-end-of-text-block () 6746 "Move forward to next 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-forward-block'." 6750 (interactive) 6751 (beginning-of-line) 6752 (skip-chars-forward " \t\n") 6753 (when (= (point) (point-min)) 6754 (forward-char)) 6755 (if (re-search-forward markdown-regex-block-separator nil t) 6756 (goto-char (match-end 0)) 6757 (goto-char (point-max))) 6758 (skip-chars-backward " \t\n") 6759 (forward-line)) 6760 6761 (defun markdown-backward-paragraph (&optional arg) 6762 "Move the point to the start of the current paragraph. 6763 With argument ARG, do it ARG times; a negative argument ARG = -N 6764 means move forward N blocks." 6765 (interactive "^p") 6766 (or arg (setq arg 1)) 6767 (if (< arg 0) 6768 (markdown-forward-paragraph (- arg)) 6769 (dotimes (_ arg) 6770 ;; Skip over whitespace in between paragraphs when moving backward. 6771 (skip-chars-backward " \t\n") 6772 (beginning-of-line) 6773 ;; Skip over code block endings. 6774 (when (markdown-range-properties-exist 6775 (line-beginning-position) (line-end-position) 6776 '(markdown-gfm-block-end 6777 markdown-tilde-fence-end)) 6778 (forward-line -1)) 6779 ;; Skip over blank lines inside blockquotes. 6780 (while (and (not (eobp)) 6781 (looking-at markdown-regex-blockquote) 6782 (= (length (match-string 3)) 0)) 6783 (forward-line -1)) 6784 ;; Proceed forward based on the type of block of paragraph. 6785 (let (bounds skip) 6786 (cond 6787 ;; Blockquotes 6788 ((looking-at markdown-regex-blockquote) 6789 (while (and (not (bobp)) 6790 (looking-at markdown-regex-blockquote) 6791 (> (length (match-string 3)) 0)) ;; not blank 6792 (forward-line -1)) 6793 (forward-line)) 6794 ;; List items 6795 ((setq bounds (markdown-cur-list-item-bounds)) 6796 (goto-char (nth 0 bounds))) 6797 ;; Other 6798 (t 6799 (while (and (not (bobp)) 6800 (not skip) 6801 (not (markdown-cur-line-blank-p)) 6802 (not (looking-at markdown-regex-blockquote)) 6803 (not (markdown-range-properties-exist 6804 (line-beginning-position) (line-end-position) 6805 '(markdown-gfm-block-end 6806 markdown-tilde-fence-end)))) 6807 (setq skip (markdown-range-properties-exist 6808 (line-beginning-position) (line-end-position) 6809 '(markdown-gfm-block-begin 6810 markdown-tilde-fence-begin))) 6811 (forward-line -1)) 6812 (unless (bobp) 6813 (forward-line 1)))))))) 6814 6815 (defun markdown-forward-paragraph (&optional arg) 6816 "Move forward to the next end of a paragraph. 6817 With argument ARG, do it ARG times; a negative argument ARG = -N 6818 means move backward N blocks." 6819 (interactive "^p") 6820 (or arg (setq arg 1)) 6821 (if (< arg 0) 6822 (markdown-backward-paragraph (- arg)) 6823 (dotimes (_ arg) 6824 ;; Skip whitespace in between paragraphs. 6825 (when (markdown-cur-line-blank-p) 6826 (skip-syntax-forward "-") 6827 (beginning-of-line)) 6828 ;; Proceed forward based on the type of block. 6829 (let (bounds skip) 6830 (cond 6831 ;; Blockquotes 6832 ((looking-at markdown-regex-blockquote) 6833 ;; Skip over blank lines inside blockquotes. 6834 (while (and (not (eobp)) 6835 (looking-at markdown-regex-blockquote) 6836 (= (length (match-string 3)) 0)) 6837 (forward-line)) 6838 ;; Move to end of quoted text block 6839 (while (and (not (eobp)) 6840 (looking-at markdown-regex-blockquote) 6841 (> (length (match-string 3)) 0)) ;; not blank 6842 (forward-line))) 6843 ;; List items 6844 ((and (markdown-cur-list-item-bounds) 6845 (setq bounds (markdown-next-list-item-bounds))) 6846 (goto-char (nth 0 bounds))) 6847 ;; Other 6848 (t 6849 (forward-line) 6850 (while (and (not (eobp)) 6851 (not skip) 6852 (not (markdown-cur-line-blank-p)) 6853 (not (looking-at markdown-regex-blockquote)) 6854 (not (markdown-range-properties-exist 6855 (line-beginning-position) (line-end-position) 6856 '(markdown-gfm-block-begin 6857 markdown-tilde-fence-begin)))) 6858 (setq skip (markdown-range-properties-exist 6859 (line-beginning-position) (line-end-position) 6860 '(markdown-gfm-block-end 6861 markdown-tilde-fence-end))) 6862 (forward-line)))))))) 6863 6864 (defun markdown-backward-block (&optional arg) 6865 "Move the point to the start of the current Markdown block. 6866 Moves across complete code blocks, list items, and blockquotes, 6867 but otherwise stops at blank lines, headers, and horizontal 6868 rules. With argument ARG, do it ARG times; a negative argument 6869 ARG = -N means move forward N blocks." 6870 (interactive "^p") 6871 (or arg (setq arg 1)) 6872 (if (< arg 0) 6873 (markdown-forward-block (- arg)) 6874 (dotimes (_ arg) 6875 ;; Skip over whitespace in between blocks when moving backward, 6876 ;; unless at a block boundary with no whitespace. 6877 (skip-syntax-backward "-") 6878 (beginning-of-line) 6879 ;; Proceed forward based on the type of block. 6880 (cond 6881 ;; Code blocks 6882 ((and (markdown-code-block-at-pos (point)) ;; this line 6883 (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line 6884 (forward-line -1) 6885 (while (and (markdown-code-block-at-point-p) (not (bobp))) 6886 (forward-line -1)) 6887 (forward-line)) 6888 ;; Headings 6889 ((markdown-heading-at-point) 6890 (goto-char (match-beginning 0))) 6891 ;; Horizontal rules 6892 ((looking-at markdown-regex-hr)) 6893 ;; Blockquotes 6894 ((looking-at markdown-regex-blockquote) 6895 (forward-line -1) 6896 (while (and (looking-at markdown-regex-blockquote) 6897 (not (bobp))) 6898 (forward-line -1)) 6899 (forward-line)) 6900 ;; List items 6901 ((markdown-cur-list-item-bounds) 6902 (markdown-beginning-of-list)) 6903 ;; Other 6904 (t 6905 ;; Move forward in case it is a one line regular paragraph. 6906 (unless (markdown-next-line-blank-p) 6907 (forward-line)) 6908 (unless (markdown-prev-line-blank-p) 6909 (markdown-backward-paragraph))))))) 6910 6911 (defun markdown-forward-block (&optional arg) 6912 "Move forward to the next end of a Markdown block. 6913 Moves across complete code blocks, list items, and blockquotes, 6914 but otherwise stops at blank lines, headers, and horizontal 6915 rules. With argument ARG, do it ARG times; a negative argument 6916 ARG = -N means move backward N blocks." 6917 (interactive "^p") 6918 (or arg (setq arg 1)) 6919 (if (< arg 0) 6920 (markdown-backward-block (- arg)) 6921 (dotimes (_ arg) 6922 ;; Skip over whitespace in between blocks when moving forward. 6923 (if (markdown-cur-line-blank-p) 6924 (skip-syntax-forward "-") 6925 (beginning-of-line)) 6926 ;; Proceed forward based on the type of block. 6927 (cond 6928 ;; Code blocks 6929 ((markdown-code-block-at-point-p) 6930 (forward-line) 6931 (while (and (markdown-code-block-at-point-p) (not (eobp))) 6932 (forward-line))) 6933 ;; Headings 6934 ((looking-at markdown-regex-header) 6935 (goto-char (or (match-end 4) (match-end 2) (match-end 3))) 6936 (forward-line)) 6937 ;; Horizontal rules 6938 ((looking-at markdown-regex-hr) 6939 (forward-line)) 6940 ;; Blockquotes 6941 ((looking-at markdown-regex-blockquote) 6942 (forward-line) 6943 (while (and (looking-at markdown-regex-blockquote) (not (eobp))) 6944 (forward-line))) 6945 ;; List items 6946 ((markdown-cur-list-item-bounds) 6947 (markdown-end-of-list) 6948 (forward-line)) 6949 ;; Other 6950 (t (markdown-forward-paragraph)))) 6951 (skip-syntax-backward "-") 6952 (unless (eobp) 6953 (forward-char 1)))) 6954 6955 (defun markdown-backward-page (&optional count) 6956 "Move backward to boundary of the current toplevel section. 6957 With COUNT, repeat, or go forward if negative." 6958 (interactive "p") 6959 (or count (setq count 1)) 6960 (if (< count 0) 6961 (markdown-forward-page (- count)) 6962 (skip-syntax-backward "-") 6963 (or (markdown-back-to-heading-over-code-block t t) 6964 (goto-char (point-min))) 6965 (when (looking-at markdown-regex-header) 6966 (let ((level (markdown-outline-level))) 6967 (when (> level 1) (markdown-up-heading level)) 6968 (when (> count 1) 6969 (condition-case nil 6970 (markdown-backward-same-level (1- count)) 6971 (error (goto-char (point-min))))))))) 6972 6973 (defun markdown-forward-page (&optional count) 6974 "Move forward to boundary of the current toplevel section. 6975 With COUNT, repeat, or go backward if negative." 6976 (interactive "p") 6977 (or count (setq count 1)) 6978 (if (< count 0) 6979 (markdown-backward-page (- count)) 6980 (if (markdown-back-to-heading-over-code-block t t) 6981 (let ((level (markdown-outline-level))) 6982 (when (> level 1) (markdown-up-heading level)) 6983 (condition-case nil 6984 (markdown-forward-same-level count) 6985 (error (goto-char (point-max))))) 6986 (markdown-next-visible-heading 1)))) 6987 6988 (defun markdown-next-link () 6989 "Jump to next inline, reference, or wiki link. 6990 If successful, return point. Otherwise, return nil. 6991 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." 6992 (interactive) 6993 (let ((opoint (point))) 6994 (when (or (markdown-link-p) (markdown-wiki-link-p)) 6995 ;; At a link already, move past it. 6996 (goto-char (+ (match-end 0) 1))) 6997 ;; Search for the next wiki link and move to the beginning. 6998 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) 6999 (markdown-code-block-at-point-p) 7000 (< (point) (point-max)))) 7001 (if (and (not (eq (point) opoint)) 7002 (or (markdown-link-p) (markdown-wiki-link-p))) 7003 ;; Group 1 will move past non-escape character in wiki link regexp. 7004 ;; Go to beginning of group zero for all other link types. 7005 (goto-char (or (match-beginning 1) (match-beginning 0))) 7006 (goto-char opoint) 7007 nil))) 7008 7009 (defun markdown-previous-link () 7010 "Jump to previous wiki link. 7011 If successful, return point. Otherwise, return nil. 7012 See `markdown-wiki-link-p' and `markdown-next-wiki-link'." 7013 (interactive) 7014 (let ((opoint (point))) 7015 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) 7016 (markdown-code-block-at-point-p) 7017 (> (point) (point-min)))) 7018 (if (and (not (eq (point) opoint)) 7019 (or (markdown-link-p) (markdown-wiki-link-p))) 7020 (goto-char (or (match-beginning 1) (match-beginning 0))) 7021 (goto-char opoint) 7022 nil))) 7023 7024 7025 ;;; Outline =================================================================== 7026 7027 (defun markdown-move-heading-common (move-fn &optional arg adjust) 7028 "Wrapper for `outline-mode' functions to skip false positives. 7029 MOVE-FN is a function and ARG is its argument. For example, 7030 headings inside preformatted code blocks may match 7031 `outline-regexp' but should not be considered as headings. 7032 When ADJUST is non-nil, adjust the point for interactive calls 7033 to avoid leaving the point at invisible markup. This adjustment 7034 generally should only be done for interactive calls, since other 7035 functions may expect the point to be at the beginning of the 7036 regular expression." 7037 (let ((prev -1) (start (point))) 7038 (if arg (funcall move-fn arg) (funcall move-fn)) 7039 (while (and (/= prev (point)) (markdown-code-block-at-point-p)) 7040 (setq prev (point)) 7041 (if arg (funcall move-fn arg) (funcall move-fn))) 7042 ;; Adjust point for setext headings and invisible text. 7043 (save-match-data 7044 (when (and adjust (thing-at-point-looking-at markdown-regex-header)) 7045 (if markdown-hide-markup 7046 ;; Move to beginning of heading text if markup is hidden. 7047 (goto-char (or (match-beginning 1) (match-beginning 5))) 7048 ;; Move to beginning of markup otherwise. 7049 (goto-char (or (match-beginning 1) (match-beginning 4)))))) 7050 (if (= (point) start) nil (point)))) 7051 7052 (defun markdown-next-visible-heading (arg) 7053 "Move to the next visible heading line of any level. 7054 With argument, repeats or can move backward if negative. ARG is 7055 passed to `outline-next-visible-heading'." 7056 (interactive "p") 7057 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) 7058 7059 (defun markdown-previous-visible-heading (arg) 7060 "Move to the previous visible heading line of any level. 7061 With argument, repeats or can move backward if negative. ARG is 7062 passed to `outline-previous-visible-heading'." 7063 (interactive "p") 7064 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) 7065 7066 (defun markdown-next-heading () 7067 "Move to the next heading line of any level." 7068 (markdown-move-heading-common #'outline-next-heading)) 7069 7070 (defun markdown-previous-heading () 7071 "Move to the previous heading line of any level." 7072 (markdown-move-heading-common #'outline-previous-heading)) 7073 7074 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) 7075 "Move back to the beginning of the previous heading. 7076 Returns t if the point is at a heading, the location if a heading 7077 was found, and nil otherwise. 7078 Only visible heading lines are considered, unless INVISIBLE-OK is 7079 non-nil. Throw an error if there is no previous heading unless 7080 NO-ERROR is non-nil. 7081 Leaves match data intact for `markdown-regex-header'." 7082 (beginning-of-line) 7083 (or (and (markdown-heading-at-point) 7084 (not (markdown-code-block-at-point-p))) 7085 (let (found) 7086 (save-excursion 7087 (while (and (not found) 7088 (re-search-backward markdown-regex-header nil t)) 7089 (when (and (or invisible-ok (not (outline-invisible-p))) 7090 (not (markdown-code-block-at-point-p))) 7091 (setq found (point)))) 7092 (if (not found) 7093 (unless no-error (user-error "Before first heading")) 7094 (setq found (point)))) 7095 (when found (goto-char found))))) 7096 7097 (defun markdown-forward-same-level (arg) 7098 "Move forward to the ARG'th heading at same level as this one. 7099 Stop at the first and last headings of a superior heading." 7100 (interactive "p") 7101 (markdown-back-to-heading-over-code-block) 7102 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) 7103 7104 (defun markdown-backward-same-level (arg) 7105 "Move backward to the ARG'th heading at same level as this one. 7106 Stop at the first and last headings of a superior heading." 7107 (interactive "p") 7108 (markdown-back-to-heading-over-code-block) 7109 (while (> arg 0) 7110 (let ((point-to-move-to 7111 (save-excursion 7112 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) 7113 (if point-to-move-to 7114 (progn 7115 (goto-char point-to-move-to) 7116 (setq arg (1- arg))) 7117 (user-error "No previous same-level heading"))))) 7118 7119 (defun markdown-up-heading (arg &optional interactive) 7120 "Move to the visible heading line of which the present line is a subheading. 7121 With argument, move up ARG levels. When called interactively (or 7122 INTERACTIVE is non-nil), also push the mark." 7123 (interactive "p\np") 7124 (and interactive (not (eq last-command 'markdown-up-heading)) 7125 (push-mark)) 7126 (markdown-move-heading-common #'outline-up-heading arg 'adjust)) 7127 7128 (defun markdown-back-to-heading (&optional invisible-ok) 7129 "Move to previous heading line, or beg of this line if it's a heading. 7130 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 7131 (interactive) 7132 (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) 7133 7134 (defalias 'markdown-end-of-heading 'outline-end-of-heading) 7135 7136 (defun markdown-on-heading-p () 7137 "Return non-nil if point is on a heading line." 7138 (get-text-property (line-beginning-position) 'markdown-heading)) 7139 7140 (defun markdown-end-of-subtree (&optional invisible-OK) 7141 "Move to the end of the current subtree. 7142 Only visible heading lines are considered, unless INVISIBLE-OK is 7143 non-nil. 7144 Derived from `org-end-of-subtree'." 7145 (markdown-back-to-heading invisible-OK) 7146 (let ((first t) 7147 (level (markdown-outline-level))) 7148 (while (and (not (eobp)) 7149 (or first (> (markdown-outline-level) level))) 7150 (setq first nil) 7151 (markdown-next-heading)) 7152 (if (memq (preceding-char) '(?\n ?\^M)) 7153 (progn 7154 ;; Go to end of line before heading 7155 (forward-char -1) 7156 (if (memq (preceding-char) '(?\n ?\^M)) 7157 ;; leave blank line before heading 7158 (forward-char -1))))) 7159 (point)) 7160 7161 (defun markdown-outline-fix-visibility () 7162 "Hide any false positive headings that should not be shown. 7163 For example, headings inside preformatted code blocks may match 7164 `outline-regexp' but should not be shown as headings when cycling. 7165 Also, the ending --- line in metadata blocks appears to be a 7166 setext header, but should not be folded." 7167 (save-excursion 7168 (goto-char (point-min)) 7169 ;; Unhide any false positives in metadata blocks 7170 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) 7171 (let ((body (progn (forward-line) 7172 (markdown-text-property-at-point 7173 'markdown-yaml-metadata-section)))) 7174 (when body 7175 (let ((end (progn (goto-char (cl-second body)) 7176 (markdown-text-property-at-point 7177 'markdown-yaml-metadata-end)))) 7178 (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) 7179 ;; Hide any false positives in code blocks 7180 (unless (outline-on-heading-p) 7181 (outline-next-visible-heading 1)) 7182 (while (< (point) (point-max)) 7183 (when (markdown-code-block-at-point-p) 7184 (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) 7185 (outline-next-visible-heading 1)))) 7186 7187 (defvar markdown-cycle-global-status 1) 7188 (defvar markdown-cycle-subtree-status nil) 7189 7190 (defun markdown-next-preface () 7191 (let (finish) 7192 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") 7193 nil 'move)) 7194 (unless (markdown-code-block-at-point-p) 7195 (goto-char (match-beginning 0)) 7196 (setq finish t)))) 7197 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) 7198 (forward-char -1))) 7199 7200 (defun markdown-show-entry () 7201 (save-excursion 7202 (outline-back-to-heading t) 7203 (outline-flag-region (1- (point)) 7204 (progn 7205 (markdown-next-preface) 7206 (if (= 1 (- (point-max) (point))) 7207 (point-max) 7208 (point))) 7209 nil))) 7210 7211 ;; This function was originally derived from `org-cycle' from org.el. 7212 (defun markdown-cycle (&optional arg) 7213 "Visibility cycling for Markdown mode. 7214 This function is called with a `\\[universal-argument]' or if ARG is t, perform 7215 global visibility cycling. If the point is at an atx-style header, cycle 7216 visibility of the corresponding subtree. Otherwise, indent the current line 7217 or insert a tab, as appropriate, by calling `indent-for-tab-command'." 7218 (interactive "P") 7219 (cond 7220 7221 ;; Global cycling 7222 (arg 7223 (cond 7224 ;; Move from overview to contents 7225 ((and (eq last-command this-command) 7226 (eq markdown-cycle-global-status 2)) 7227 (outline-hide-sublevels 1) 7228 (message "CONTENTS") 7229 (setq markdown-cycle-global-status 3) 7230 (markdown-outline-fix-visibility)) 7231 ;; Move from contents to all 7232 ((and (eq last-command this-command) 7233 (eq markdown-cycle-global-status 3)) 7234 (outline-show-all) 7235 (message "SHOW ALL") 7236 (setq markdown-cycle-global-status 1)) 7237 ;; Defaults to overview 7238 (t 7239 (outline-hide-body) 7240 (message "OVERVIEW") 7241 (setq markdown-cycle-global-status 2) 7242 (markdown-outline-fix-visibility)))) 7243 7244 ;; At a heading: rotate between three different views 7245 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) 7246 (markdown-back-to-heading) 7247 (let ((goal-column 0) eoh eol eos) 7248 ;; Determine boundaries 7249 (save-excursion 7250 (markdown-back-to-heading) 7251 (save-excursion 7252 (beginning-of-line 2) 7253 (while (and (not (eobp)) ;; this is like `next-line' 7254 (get-char-property (1- (point)) 'invisible)) 7255 (beginning-of-line 2)) (setq eol (point))) 7256 (markdown-end-of-heading) (setq eoh (point)) 7257 (markdown-end-of-subtree t) 7258 (skip-chars-forward " \t\n") 7259 (beginning-of-line 1) ; in case this is an item 7260 (setq eos (1- (point)))) 7261 ;; Find out what to do next and set `this-command' 7262 (cond 7263 ;; Nothing is hidden behind this heading 7264 ((= eos eoh) 7265 (message "EMPTY ENTRY") 7266 (setq markdown-cycle-subtree-status nil)) 7267 ;; Entire subtree is hidden in one line: open it 7268 ((>= eol eos) 7269 (markdown-show-entry) 7270 (outline-show-children) 7271 (message "CHILDREN") 7272 (setq markdown-cycle-subtree-status 'children)) 7273 ;; We just showed the children, now show everything. 7274 ((and (eq last-command this-command) 7275 (eq markdown-cycle-subtree-status 'children)) 7276 (outline-show-subtree) 7277 (message "SUBTREE") 7278 (setq markdown-cycle-subtree-status 'subtree)) 7279 ;; Default action: hide the subtree. 7280 (t 7281 (outline-hide-subtree) 7282 (message "FOLDED") 7283 (setq markdown-cycle-subtree-status 'folded))))) 7284 7285 ;; In a table, move forward by one cell 7286 ((markdown-table-at-point-p) 7287 (call-interactively #'markdown-table-forward-cell)) 7288 7289 ;; Otherwise, indent as appropriate 7290 (t 7291 (indent-for-tab-command)))) 7292 7293 (defun markdown-shifttab () 7294 "Handle S-TAB keybinding based on context. 7295 When in a table, move backward one cell. 7296 Otherwise, cycle global heading visibility by calling 7297 `markdown-cycle' with argument t." 7298 (interactive) 7299 (cond ((markdown-table-at-point-p) 7300 (call-interactively #'markdown-table-backward-cell)) 7301 (t (markdown-cycle t)))) 7302 7303 (defun markdown-outline-level () 7304 "Return the depth to which a statement is nested in the outline." 7305 (cond 7306 ((and (match-beginning 0) 7307 (markdown-code-block-at-pos (match-beginning 0))) 7308 7) ;; Only 6 header levels are defined. 7309 ((match-end 2) 1) 7310 ((match-end 3) 2) 7311 ((match-end 4) 7312 (length (markdown-trim-whitespace (match-string-no-properties 4)))))) 7313 7314 (defun markdown-promote-subtree (&optional arg) 7315 "Promote the current subtree of ATX headings. 7316 Note that Markdown does not support heading levels higher than 7317 six and therefore level-six headings will not be promoted 7318 further. If ARG is non-nil promote the heading, otherwise 7319 demote." 7320 (interactive "*P") 7321 (save-excursion 7322 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) 7323 (re-search-backward markdown-regex-header-atx nil t)) 7324 (not (markdown-code-block-at-point-p))) 7325 (let ((level (length (match-string 1))) 7326 (promote-or-demote (if arg 1 -1)) 7327 (remove 't)) 7328 (markdown-cycle-atx promote-or-demote remove) 7329 (catch 'end-of-subtree 7330 (while (and (markdown-next-heading) 7331 (looking-at markdown-regex-header-atx)) 7332 ;; Exit if this not a higher level heading; promote otherwise. 7333 (if (and (looking-at markdown-regex-header-atx) 7334 (<= (length (match-string-no-properties 1)) level)) 7335 (throw 'end-of-subtree nil) 7336 (markdown-cycle-atx promote-or-demote remove)))))))) 7337 7338 (defun markdown-demote-subtree () 7339 "Demote the current subtree of ATX headings." 7340 (interactive) 7341 (markdown-promote-subtree t)) 7342 7343 (defun markdown-move-subtree-up () 7344 "Move the current subtree of ATX headings up." 7345 (interactive) 7346 (outline-move-subtree-up 1)) 7347 7348 (defun markdown-move-subtree-down () 7349 "Move the current subtree of ATX headings down." 7350 (interactive) 7351 (outline-move-subtree-down 1)) 7352 7353 (defun markdown-outline-next () 7354 "Move to next list item, when in a list, or next visible heading." 7355 (interactive) 7356 (let ((bounds (markdown-next-list-item-bounds))) 7357 (if bounds 7358 (goto-char (nth 0 bounds)) 7359 (markdown-next-visible-heading 1)))) 7360 7361 (defun markdown-outline-previous () 7362 "Move to previous list item, when in a list, or previous visible heading." 7363 (interactive) 7364 (let ((bounds (markdown-prev-list-item-bounds))) 7365 (if bounds 7366 (goto-char (nth 0 bounds)) 7367 (markdown-previous-visible-heading 1)))) 7368 7369 (defun markdown-outline-next-same-level () 7370 "Move to next list item or heading of same level." 7371 (interactive) 7372 (let ((bounds (markdown-cur-list-item-bounds))) 7373 (if bounds 7374 (markdown-next-list-item (nth 3 bounds)) 7375 (markdown-forward-same-level 1)))) 7376 7377 (defun markdown-outline-previous-same-level () 7378 "Move to previous list item or heading of same level." 7379 (interactive) 7380 (let ((bounds (markdown-cur-list-item-bounds))) 7381 (if bounds 7382 (markdown-prev-list-item (nth 3 bounds)) 7383 (markdown-backward-same-level 1)))) 7384 7385 (defun markdown-outline-up () 7386 "Move to previous list item, when in a list, or previous heading." 7387 (interactive) 7388 (unless (markdown-up-list) 7389 (markdown-up-heading 1))) 7390 7391 7392 ;;; Marking and Narrowing ===================================================== 7393 7394 (defun markdown-mark-paragraph () 7395 "Put mark at end of this block, point at beginning. 7396 The block marked is the one that contains point or follows point. 7397 7398 Interactively, if this command is repeated or (in Transient Mark 7399 mode) if the mark is active, it marks the next block after the 7400 ones already marked." 7401 (interactive) 7402 (if (or (and (eq last-command this-command) (mark t)) 7403 (and transient-mark-mode mark-active)) 7404 (set-mark 7405 (save-excursion 7406 (goto-char (mark)) 7407 (markdown-forward-paragraph) 7408 (point))) 7409 (let ((beginning-of-defun-function #'markdown-backward-paragraph) 7410 (end-of-defun-function #'markdown-forward-paragraph)) 7411 (mark-defun)))) 7412 7413 (defun markdown-mark-block () 7414 "Put mark at end of this block, point at beginning. 7415 The block marked is the one that contains point or follows point. 7416 7417 Interactively, if this command is repeated or (in Transient Mark 7418 mode) if the mark is active, it marks the next block after the 7419 ones already marked." 7420 (interactive) 7421 (if (or (and (eq last-command this-command) (mark t)) 7422 (and transient-mark-mode mark-active)) 7423 (set-mark 7424 (save-excursion 7425 (goto-char (mark)) 7426 (markdown-forward-block) 7427 (point))) 7428 (let ((beginning-of-defun-function #'markdown-backward-block) 7429 (end-of-defun-function #'markdown-forward-block)) 7430 (mark-defun)))) 7431 7432 (defun markdown-narrow-to-block () 7433 "Make text outside current block invisible. 7434 The current block is the one that contains point or follows point." 7435 (interactive) 7436 (let ((beginning-of-defun-function #'markdown-backward-block) 7437 (end-of-defun-function #'markdown-forward-block)) 7438 (narrow-to-defun))) 7439 7440 (defun markdown-mark-text-block () 7441 "Put mark at end of this plain text block, point at beginning. 7442 The block marked is the one that contains point or follows point. 7443 7444 Interactively, if this command is repeated or (in Transient Mark 7445 mode) if the mark is active, it marks the next block after the 7446 ones already marked." 7447 (interactive) 7448 (if (or (and (eq last-command this-command) (mark t)) 7449 (and transient-mark-mode mark-active)) 7450 (set-mark 7451 (save-excursion 7452 (goto-char (mark)) 7453 (markdown-end-of-text-block) 7454 (point))) 7455 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) 7456 (end-of-defun-function #'markdown-end-of-text-block)) 7457 (mark-defun)))) 7458 7459 (defun markdown-mark-page () 7460 "Put mark at end of this top level section, point at beginning. 7461 The top level section marked is the one that contains point or 7462 follows point. 7463 7464 Interactively, if this command is repeated or (in Transient Mark 7465 mode) if the mark is active, it marks the next page after the 7466 ones already marked." 7467 (interactive) 7468 (if (or (and (eq last-command this-command) (mark t)) 7469 (and transient-mark-mode mark-active)) 7470 (set-mark 7471 (save-excursion 7472 (goto-char (mark)) 7473 (markdown-forward-page) 7474 (point))) 7475 (let ((beginning-of-defun-function #'markdown-backward-page) 7476 (end-of-defun-function #'markdown-forward-page)) 7477 (mark-defun)))) 7478 7479 (defun markdown-narrow-to-page () 7480 "Make text outside current top level section invisible. 7481 The current section is the one that contains point or follows point." 7482 (interactive) 7483 (let ((beginning-of-defun-function #'markdown-backward-page) 7484 (end-of-defun-function #'markdown-forward-page)) 7485 (narrow-to-defun))) 7486 7487 (defun markdown-mark-subtree () 7488 "Mark the current subtree. 7489 This puts point at the start of the current subtree, and mark at the end." 7490 (interactive) 7491 (let ((beg)) 7492 (if (markdown-heading-at-point) 7493 (beginning-of-line) 7494 (markdown-previous-visible-heading 1)) 7495 (setq beg (point)) 7496 (markdown-end-of-subtree) 7497 (push-mark (point) nil t) 7498 (goto-char beg))) 7499 7500 (defun markdown-narrow-to-subtree () 7501 "Narrow buffer to the current subtree." 7502 (interactive) 7503 (save-excursion 7504 (save-match-data 7505 (narrow-to-region 7506 (progn (markdown-back-to-heading-over-code-block t) (point)) 7507 (progn (markdown-end-of-subtree) 7508 (if (and (markdown-heading-at-point) (not (eobp))) 7509 (backward-char 1)) 7510 (point)))))) 7511 7512 7513 ;;; Generic Structure Editing, Completion, and Cycling Commands =============== 7514 7515 (defun markdown-move-up () 7516 "Move thing at point up. 7517 When in a list item, call `markdown-move-list-item-up'. 7518 When in a table, call `markdown-table-move-row-up'. 7519 Otherwise, move the current heading subtree up with 7520 `markdown-move-subtree-up'." 7521 (interactive) 7522 (cond 7523 ((markdown-list-item-at-point-p) 7524 (call-interactively #'markdown-move-list-item-up)) 7525 ((markdown-table-at-point-p) 7526 (call-interactively #'markdown-table-move-row-up)) 7527 (t 7528 (call-interactively #'markdown-move-subtree-up)))) 7529 7530 (defun markdown-move-down () 7531 "Move thing at point down. 7532 When in a list item, call `markdown-move-list-item-down'. 7533 Otherwise, move the current heading subtree up with 7534 `markdown-move-subtree-down'." 7535 (interactive) 7536 (cond 7537 ((markdown-list-item-at-point-p) 7538 (call-interactively #'markdown-move-list-item-down)) 7539 ((markdown-table-at-point-p) 7540 (call-interactively #'markdown-table-move-row-down)) 7541 (t 7542 (call-interactively #'markdown-move-subtree-down)))) 7543 7544 (defun markdown-promote () 7545 "Promote or move element at point to the left. 7546 Depending on the context, this function will promote a heading or 7547 list item at the point, move a table column to the left, or cycle 7548 markup." 7549 (interactive) 7550 (let (bounds) 7551 (cond 7552 ;; Promote atx heading subtree 7553 ((thing-at-point-looking-at markdown-regex-header-atx) 7554 (markdown-promote-subtree)) 7555 ;; Promote setext heading 7556 ((thing-at-point-looking-at markdown-regex-header-setext) 7557 (markdown-cycle-setext -1)) 7558 ;; Promote horizontal rule 7559 ((thing-at-point-looking-at markdown-regex-hr) 7560 (markdown-cycle-hr -1)) 7561 ;; Promote list item 7562 ((setq bounds (markdown-cur-list-item-bounds)) 7563 (markdown-promote-list-item bounds)) 7564 ;; Move table column to the left 7565 ((markdown-table-at-point-p) 7566 (call-interactively #'markdown-table-move-column-left)) 7567 ;; Promote bold 7568 ((thing-at-point-looking-at markdown-regex-bold) 7569 (markdown-cycle-bold)) 7570 ;; Promote italic 7571 ((thing-at-point-looking-at markdown-regex-italic) 7572 (markdown-cycle-italic)) 7573 (t 7574 (user-error "Nothing to promote at point"))))) 7575 7576 (defun markdown-demote () 7577 "Demote or move element at point to the right. 7578 Depending on the context, this function will demote a heading or 7579 list item at the point, move a table column to the right, or cycle 7580 or remove markup." 7581 (interactive) 7582 (let (bounds) 7583 (cond 7584 ;; Demote atx heading subtree 7585 ((thing-at-point-looking-at markdown-regex-header-atx) 7586 (markdown-demote-subtree)) 7587 ;; Demote setext heading 7588 ((thing-at-point-looking-at markdown-regex-header-setext) 7589 (markdown-cycle-setext 1)) 7590 ;; Demote horizontal rule 7591 ((thing-at-point-looking-at markdown-regex-hr) 7592 (markdown-cycle-hr 1)) 7593 ;; Demote list item 7594 ((setq bounds (markdown-cur-list-item-bounds)) 7595 (markdown-demote-list-item bounds)) 7596 ;; Move table column to the right 7597 ((markdown-table-at-point-p) 7598 (call-interactively #'markdown-table-move-column-right)) 7599 ;; Demote bold 7600 ((thing-at-point-looking-at markdown-regex-bold) 7601 (markdown-cycle-bold)) 7602 ;; Demote italic 7603 ((thing-at-point-looking-at markdown-regex-italic) 7604 (markdown-cycle-italic)) 7605 (t 7606 (user-error "Nothing to demote at point"))))) 7607 7608 7609 ;;; Commands ================================================================== 7610 7611 (defun markdown (&optional output-buffer-name) 7612 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. 7613 The output buffer name defaults to `markdown-output-buffer-name'. 7614 Return the name of the output buffer used." 7615 (interactive) 7616 (save-window-excursion 7617 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) 7618 ((listp markdown-command) markdown-command))) 7619 (command (car-safe commands)) 7620 (command-args (cdr-safe commands)) 7621 begin-region end-region) 7622 (if (use-region-p) 7623 (setq begin-region (region-beginning) 7624 end-region (region-end)) 7625 (setq begin-region (point-min) 7626 end-region (point-max))) 7627 7628 (unless output-buffer-name 7629 (setq output-buffer-name markdown-output-buffer-name)) 7630 (when (and (stringp command) (not (executable-find command))) 7631 (user-error "Markdown command %s is not found" command)) 7632 (let ((exit-code 7633 (cond 7634 ;; Handle case when `markdown-command' does not read from stdin 7635 ((and (stringp command) markdown-command-needs-filename) 7636 (if (not buffer-file-name) 7637 (user-error "Must be visiting a file") 7638 ;; Don’t use ‘shell-command’ because it’s not guaranteed to 7639 ;; return the exit code of the process. 7640 (let ((command (if (listp markdown-command) 7641 (string-join markdown-command " ") 7642 markdown-command))) 7643 (shell-command-on-region 7644 ;; Pass an empty region so that stdin is empty. 7645 (point) (point) 7646 (concat command " " 7647 (shell-quote-argument buffer-file-name)) 7648 output-buffer-name)))) 7649 ;; Pass region to `markdown-command' via stdin 7650 (t 7651 (let ((buf (get-buffer-create output-buffer-name))) 7652 (with-current-buffer buf 7653 (setq buffer-read-only nil) 7654 (erase-buffer)) 7655 (if (stringp command) 7656 (if (not (null command-args)) 7657 (apply #'call-process-region begin-region end-region command nil buf nil command-args) 7658 (call-process-region begin-region end-region command nil buf)) 7659 (if markdown-command-needs-filename 7660 (if (not buffer-file-name) 7661 (user-error "Must be visiting a file") 7662 (funcall markdown-command begin-region end-region buf buffer-file-name)) 7663 (funcall markdown-command begin-region end-region buf)) 7664 ;; If the ‘markdown-command’ function didn’t signal an 7665 ;; error, assume it succeeded by binding ‘exit-code’ to 0. 7666 0)))))) 7667 ;; The exit code can be a signal description string, so don’t use ‘=’ 7668 ;; or ‘zerop’. 7669 (unless (eq exit-code 0) 7670 (user-error "%s failed with exit code %s" 7671 markdown-command exit-code)))) 7672 output-buffer-name)) 7673 7674 (defun markdown-standalone (&optional output-buffer-name) 7675 "Special function to provide standalone HTML output. 7676 Insert the output in the buffer named OUTPUT-BUFFER-NAME." 7677 (interactive) 7678 (setq output-buffer-name (markdown output-buffer-name)) 7679 (let ((css-path markdown-css-paths)) 7680 (with-current-buffer output-buffer-name 7681 (set-buffer output-buffer-name) 7682 (setq-local markdown-css-paths css-path) 7683 (unless (markdown-output-standalone-p) 7684 (markdown-add-xhtml-header-and-footer output-buffer-name)) 7685 (goto-char (point-min)) 7686 (html-mode))) 7687 output-buffer-name) 7688 7689 (defun markdown-other-window (&optional output-buffer-name) 7690 "Run `markdown-command' on current buffer and display in other window. 7691 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7692 that name." 7693 (interactive) 7694 (markdown-display-buffer-other-window 7695 (markdown-standalone output-buffer-name))) 7696 7697 (defun markdown-output-standalone-p () 7698 "Determine whether `markdown-command' output is standalone XHTML. 7699 Standalone XHTML output is identified by an occurrence of 7700 `markdown-xhtml-standalone-regexp' in the first five lines of output." 7701 (save-excursion 7702 (goto-char (point-min)) 7703 (save-match-data 7704 (re-search-forward 7705 markdown-xhtml-standalone-regexp 7706 (save-excursion (goto-char (point-min)) (forward-line 4) (point)) 7707 t)))) 7708 7709 (defun markdown-stylesheet-link-string (stylesheet-path) 7710 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" 7711 (or (and (string-prefix-p "~" stylesheet-path) 7712 (expand-file-name stylesheet-path)) 7713 stylesheet-path) 7714 "\" />")) 7715 7716 (defun markdown-escape-title (title) 7717 "Escape a minimum set of characters in TITLE so they don't clash with html." 7718 (replace-regexp-in-string ">" ">" 7719 (replace-regexp-in-string "<" "<" 7720 (replace-regexp-in-string "&" "&" title)))) 7721 7722 (defun markdown-add-xhtml-header-and-footer (title) 7723 "Wrap XHTML header and footer with given TITLE around current buffer." 7724 (goto-char (point-min)) 7725 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" 7726 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" 7727 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" 7728 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" 7729 "<head>\n<title>") 7730 (insert (markdown-escape-title title)) 7731 (insert "</title>\n") 7732 (unless (= (length markdown-content-type) 0) 7733 (insert 7734 (format 7735 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" 7736 markdown-content-type 7737 (or (and markdown-coding-system 7738 (coding-system-get markdown-coding-system 7739 'mime-charset)) 7740 (coding-system-get buffer-file-coding-system 7741 'mime-charset) 7742 "utf-8")))) 7743 (if (> (length markdown-css-paths) 0) 7744 (insert (mapconcat #'markdown-stylesheet-link-string 7745 markdown-css-paths "\n"))) 7746 (when (> (length markdown-xhtml-header-content) 0) 7747 (insert markdown-xhtml-header-content)) 7748 (insert "\n</head>\n\n" 7749 "<body>\n\n") 7750 (when (> (length markdown-xhtml-body-preamble) 0) 7751 (insert markdown-xhtml-body-preamble "\n")) 7752 (goto-char (point-max)) 7753 (when (> (length markdown-xhtml-body-epilogue) 0) 7754 (insert "\n" markdown-xhtml-body-epilogue)) 7755 (insert "\n" 7756 "</body>\n" 7757 "</html>\n")) 7758 7759 (defun markdown-preview (&optional output-buffer-name) 7760 "Run `markdown-command' on the current buffer and view output in browser. 7761 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7762 that name." 7763 (interactive) 7764 (browse-url-of-buffer 7765 (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) 7766 7767 (defun markdown-export-file-name (&optional extension) 7768 "Attempt to generate a filename for Markdown output. 7769 The file extension will be EXTENSION if given, or .html by default. 7770 If the current buffer is visiting a file, we construct a new 7771 output filename based on that filename. Otherwise, return nil." 7772 (when (buffer-file-name) 7773 (unless extension 7774 (setq extension ".html")) 7775 (let ((candidate 7776 (concat 7777 (cond 7778 ((buffer-file-name) 7779 (file-name-sans-extension (buffer-file-name))) 7780 (t (buffer-name))) 7781 extension))) 7782 (cond 7783 ((equal candidate (buffer-file-name)) 7784 (concat candidate extension)) 7785 (t 7786 candidate))))) 7787 7788 (defun markdown-export (&optional output-file) 7789 "Run Markdown on the current buffer, save to file, and return the filename. 7790 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename 7791 generated by `markdown-export-file-name', which will be constructed using the 7792 current filename, but with the extension removed and replaced with .html." 7793 (interactive) 7794 (unless output-file 7795 (setq output-file (markdown-export-file-name ".html"))) 7796 (when output-file 7797 (let* ((init-buf (current-buffer)) 7798 (init-point (point)) 7799 (init-buf-string (buffer-string)) 7800 (output-buffer (find-file-noselect output-file)) 7801 (output-buffer-name (buffer-name output-buffer))) 7802 (run-hooks 'markdown-before-export-hook) 7803 (markdown-standalone output-buffer-name) 7804 (with-current-buffer output-buffer 7805 (run-hooks 'markdown-after-export-hook) 7806 (save-buffer) 7807 (when markdown-export-kill-buffer (kill-buffer))) 7808 ;; if modified, restore initial buffer 7809 (when (buffer-modified-p init-buf) 7810 (erase-buffer) 7811 (insert init-buf-string) 7812 (save-buffer) 7813 (goto-char init-point)) 7814 output-file))) 7815 7816 (defun markdown-export-and-preview () 7817 "Export to XHTML using `markdown-export' and browse the resulting file." 7818 (interactive) 7819 (browse-url-of-file (markdown-export))) 7820 7821 (defvar-local markdown-live-preview-buffer nil 7822 "Buffer used to preview markdown output in `markdown-live-preview-export'.") 7823 7824 (defvar-local markdown-live-preview-source-buffer nil 7825 "Source buffer from which current buffer was generated. 7826 This is the inverse of `markdown-live-preview-buffer'.") 7827 7828 (defvar markdown-live-preview-currently-exporting nil) 7829 7830 (defun markdown-live-preview-get-filename () 7831 "Standardize the filename exported by `markdown-live-preview-export'." 7832 (markdown-export-file-name ".html")) 7833 7834 (defun markdown-live-preview-window-eww (file) 7835 "Preview FILE with eww. 7836 To be used with `markdown-live-preview-window-function'." 7837 (when (and (bound-and-true-p eww-auto-rename-buffer) 7838 markdown-live-preview-buffer) 7839 (kill-buffer markdown-live-preview-buffer)) 7840 (eww-open-file file) 7841 ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" 7842 ;; Try to find the buffer whose name ends with "eww*" 7843 (if (bound-and-true-p eww-auto-rename-buffer) 7844 (cl-loop for buf in (buffer-list) 7845 when (string-match-p "eww\\*\\'" (buffer-name buf)) 7846 return buf) 7847 (get-buffer "*eww*"))) 7848 7849 (defun markdown-visual-lines-between-points (beg end) 7850 (save-excursion 7851 (goto-char beg) 7852 (cl-loop with count = 0 7853 while (progn (end-of-visual-line) 7854 (and (< (point) end) (line-move-visual 1 t))) 7855 do (cl-incf count) 7856 finally return count))) 7857 7858 (defun markdown-live-preview-window-serialize (buf) 7859 "Get window point and scroll data for all windows displaying BUF." 7860 (when (buffer-live-p buf) 7861 (with-current-buffer buf 7862 (mapcar 7863 (lambda (win) 7864 (with-selected-window win 7865 (let* ((start (window-start)) 7866 (pt (window-point)) 7867 (pt-or-sym (cond ((= pt (point-min)) 'min) 7868 ((= pt (point-max)) 'max) 7869 (t pt))) 7870 (diff (markdown-visual-lines-between-points 7871 start pt))) 7872 (list win pt-or-sym diff)))) 7873 (get-buffer-window-list buf))))) 7874 7875 (defun markdown-get-point-back-lines (pt num-lines) 7876 (save-excursion 7877 (goto-char pt) 7878 (line-move-visual (- num-lines) t) 7879 ;; in testing, can occasionally overshoot the number of lines to traverse 7880 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) 7881 (when (> actual-num-lines num-lines) 7882 (line-move-visual (- actual-num-lines num-lines) t))) 7883 (point))) 7884 7885 (defun markdown-live-preview-window-deserialize (window-posns) 7886 "Apply window point and scroll data from WINDOW-POSNS. 7887 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." 7888 (cl-destructuring-bind (win pt-or-sym diff) window-posns 7889 (when (window-live-p win) 7890 (with-current-buffer markdown-live-preview-buffer 7891 (set-window-buffer win (current-buffer)) 7892 (cl-destructuring-bind (actual-pt actual-diff) 7893 (cl-case pt-or-sym 7894 (min (list (point-min) 0)) 7895 (max (list (point-max) diff)) 7896 (t (list pt-or-sym diff))) 7897 (set-window-start 7898 win (markdown-get-point-back-lines actual-pt actual-diff)) 7899 (set-window-point win actual-pt)))))) 7900 7901 (defun markdown-live-preview-export () 7902 "Export to XHTML using `markdown-export'. 7903 Browse the resulting file within Emacs using 7904 `markdown-live-preview-window-function' Return the buffer 7905 displaying the rendered output." 7906 (interactive) 7907 (let ((filename (markdown-live-preview-get-filename))) 7908 (when filename 7909 (let* ((markdown-live-preview-currently-exporting t) 7910 (cur-buf (current-buffer)) 7911 (export-file (markdown-export filename)) 7912 ;; get positions in all windows currently displaying output buffer 7913 (window-data 7914 (markdown-live-preview-window-serialize 7915 markdown-live-preview-buffer))) 7916 (save-window-excursion 7917 (let ((output-buffer 7918 (funcall markdown-live-preview-window-function export-file))) 7919 (with-current-buffer output-buffer 7920 (setq markdown-live-preview-source-buffer cur-buf) 7921 (add-hook 'kill-buffer-hook 7922 #'markdown-live-preview-remove-on-kill t t)) 7923 (with-current-buffer cur-buf 7924 (setq markdown-live-preview-buffer output-buffer)))) 7925 (with-current-buffer cur-buf 7926 ;; reset all windows displaying output buffer to where they were, 7927 ;; now with the new output 7928 (mapc #'markdown-live-preview-window-deserialize window-data) 7929 ;; delete html editing buffer 7930 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) 7931 (when (and export-file (file-exists-p export-file) 7932 (eq markdown-live-preview-delete-export 7933 'delete-on-export)) 7934 (delete-file export-file)) 7935 markdown-live-preview-buffer))))) 7936 7937 (defun markdown-live-preview-remove () 7938 (when (buffer-live-p markdown-live-preview-buffer) 7939 (kill-buffer markdown-live-preview-buffer)) 7940 (setq markdown-live-preview-buffer nil) 7941 ;; if set to 'delete-on-export, the output has already been deleted 7942 (when (eq markdown-live-preview-delete-export 'delete-on-destroy) 7943 (let ((outfile-name (markdown-live-preview-get-filename))) 7944 (when (and outfile-name (file-exists-p outfile-name)) 7945 (delete-file outfile-name))))) 7946 7947 (defun markdown-get-other-window () 7948 "Find another window to display preview or output content." 7949 (cond 7950 ((memq markdown-split-window-direction '(vertical below)) 7951 (or (window-in-direction 'below) (split-window-vertically))) 7952 ((memq markdown-split-window-direction '(horizontal right)) 7953 (or (window-in-direction 'right) (split-window-horizontally))) 7954 (t (split-window-sensibly (get-buffer-window))))) 7955 7956 (defun markdown-display-buffer-other-window (buf) 7957 "Display preview or output buffer BUF in another window." 7958 (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) 7959 (display-buffer buf) 7960 (let ((cur-buf (current-buffer)) 7961 (window (markdown-get-other-window))) 7962 (set-window-buffer window buf) 7963 (set-buffer cur-buf)))) 7964 7965 (defun markdown-live-preview-if-markdown () 7966 (when (and (derived-mode-p 'markdown-mode) 7967 markdown-live-preview-mode) 7968 (unless markdown-live-preview-currently-exporting 7969 (if (buffer-live-p markdown-live-preview-buffer) 7970 (markdown-live-preview-export) 7971 (markdown-display-buffer-other-window 7972 (markdown-live-preview-export)))))) 7973 7974 (defun markdown-live-preview-remove-on-kill () 7975 (cond ((and (derived-mode-p 'markdown-mode) 7976 markdown-live-preview-mode) 7977 (markdown-live-preview-remove)) 7978 (markdown-live-preview-source-buffer 7979 (with-current-buffer markdown-live-preview-source-buffer 7980 (setq markdown-live-preview-buffer nil)) 7981 (setq markdown-live-preview-source-buffer nil)))) 7982 7983 (defun markdown-live-preview-switch-to-output () 7984 "Turn on `markdown-live-preview-mode' and switch to output buffer. 7985 The output buffer is opened in another window." 7986 (interactive) 7987 (if markdown-live-preview-mode 7988 (markdown-display-buffer-other-window (markdown-live-preview-export))) 7989 (markdown-live-preview-mode)) 7990 7991 (defun markdown-live-preview-re-export () 7992 "Re-export the current live previewed content. 7993 If the current buffer is a buffer displaying the exported version of a 7994 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and 7995 update this buffer's contents." 7996 (interactive) 7997 (when markdown-live-preview-source-buffer 7998 (with-current-buffer markdown-live-preview-source-buffer 7999 (markdown-live-preview-export)))) 8000 8001 (defun markdown-open () 8002 "Open file for the current buffer with `markdown-open-command'." 8003 (interactive) 8004 (unless markdown-open-command 8005 (user-error "Variable `markdown-open-command' must be set")) 8006 (if (stringp markdown-open-command) 8007 (if (not buffer-file-name) 8008 (user-error "Must be visiting a file") 8009 (save-buffer) 8010 (let ((exit-code (call-process markdown-open-command nil nil nil 8011 buffer-file-name))) 8012 ;; The exit code can be a signal description string, so don’t use ‘=’ 8013 ;; or ‘zerop’. 8014 (unless (eq exit-code 0) 8015 (user-error "%s failed with exit code %s" 8016 markdown-open-command exit-code)))) 8017 (funcall markdown-open-command)) 8018 nil) 8019 8020 (defun markdown-kill-ring-save () 8021 "Run Markdown on file and store output in the kill ring." 8022 (interactive) 8023 (save-window-excursion 8024 (markdown) 8025 (with-current-buffer markdown-output-buffer-name 8026 (kill-ring-save (point-min) (point-max))))) 8027 8028 8029 ;;; Links ===================================================================== 8030 8031 (defun markdown-backward-to-link-start () 8032 "Backward link start position if current position is in link title." 8033 ;; Issue #305 8034 (when (eq (get-text-property (point) 'face) 'markdown-link-face) 8035 (skip-chars-backward "^[") 8036 (forward-char -1))) 8037 8038 (defun markdown-link-p () 8039 "Return non-nil when `point' is at a non-wiki link. 8040 See `markdown-wiki-link-p' for more information." 8041 (save-excursion 8042 (let ((case-fold-search nil)) 8043 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) 8044 (markdown-backward-to-link-start) 8045 (or (thing-at-point-looking-at markdown-regex-link-inline) 8046 (thing-at-point-looking-at markdown-regex-link-reference) 8047 (thing-at-point-looking-at markdown-regex-uri) 8048 (thing-at-point-looking-at markdown-regex-angle-uri)))))) 8049 8050 (defun markdown-link-at-pos (pos) 8051 "Return properties of link or image at position POS. 8052 Value is a list of elements describing the link: 8053 0. beginning position 8054 1. end position 8055 2. link text 8056 3. URL 8057 4. reference label 8058 5. title text 8059 6. bang (nil or \"!\")" 8060 (save-excursion 8061 (goto-char pos) 8062 (markdown-backward-to-link-start) 8063 (let (begin end text url reference title bang) 8064 (cond 8065 ;; Inline image or link at point. 8066 ((thing-at-point-looking-at markdown-regex-link-inline) 8067 (setq bang (match-string-no-properties 1) 8068 begin (match-beginning 0) 8069 text (match-string-no-properties 3) 8070 url (match-string-no-properties 6)) 8071 ;; consider nested parentheses 8072 ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link 8073 (let* ((close-pos (scan-sexps (match-beginning 5) 1)) 8074 (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) 8075 (setq end close-pos) 8076 ;; A link can contain spaces if it is wrapped with angle brackets 8077 (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) 8078 (setq url (match-string-no-properties 1 destination-part))) 8079 ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) 8080 (setq url (match-string-no-properties 1 destination-part) 8081 title (substring (match-string-no-properties 2 destination-part) 1 -1))) 8082 (t (setq url destination-part))) 8083 (setq url (url-unhex-string url)))) 8084 ;; Reference link at point. 8085 ((thing-at-point-looking-at markdown-regex-link-reference) 8086 (setq bang (match-string-no-properties 1) 8087 begin (match-beginning 0) 8088 end (match-end 0) 8089 text (match-string-no-properties 3)) 8090 (when (char-equal (char-after (match-beginning 5)) ?\[) 8091 (setq reference (match-string-no-properties 6)))) 8092 ;; Angle bracket URI at point. 8093 ((thing-at-point-looking-at markdown-regex-angle-uri) 8094 (setq begin (match-beginning 0) 8095 end (match-end 0) 8096 url (match-string-no-properties 2))) 8097 ;; Plain URI at point. 8098 ((thing-at-point-looking-at markdown-regex-uri) 8099 (setq begin (match-beginning 0) 8100 end (match-end 0) 8101 url (match-string-no-properties 1)))) 8102 (list begin end text url reference title bang)))) 8103 8104 (defun markdown-link-url () 8105 "Return the URL part of the regular (non-wiki) link at point. 8106 Works with both inline and reference style links, and with images. 8107 If point is not at a link or the link reference is not defined 8108 returns nil." 8109 (let* ((values (markdown-link-at-pos (point))) 8110 (text (nth 2 values)) 8111 (url (nth 3 values)) 8112 (ref (nth 4 values))) 8113 (or url (and ref (car (markdown-reference-definition 8114 (downcase (if (string= ref "") text ref)))))))) 8115 8116 (defun markdown--browse-url (url) 8117 (let* ((struct (url-generic-parse-url url)) 8118 (full (url-fullness struct)) 8119 (file url)) 8120 ;; Parse URL, determine fullness, strip query string 8121 (setq file (car (url-path-and-query struct))) 8122 ;; Open full URLs in browser, files in Emacs 8123 (if full 8124 (browse-url url) 8125 (when (and file (> (length file) 0)) 8126 (let ((link-file (funcall markdown-translate-filename-function file))) 8127 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) 8128 (if (functionp markdown-open-image-command) 8129 (funcall markdown-open-image-command link-file) 8130 (process-file markdown-open-image-command nil nil nil link-file)) 8131 (find-file link-file))))))) 8132 8133 (defun markdown-follow-link-at-point (&optional event) 8134 "Open the non-wiki link at point or EVENT. 8135 If the link is a complete URL, open in browser with `browse-url'. 8136 Otherwise, open with `find-file' after stripping anchor and/or query string. 8137 Translate filenames using `markdown-filename-translate-function'." 8138 (interactive (list last-command-event)) 8139 (if event (posn-set-point (event-start event))) 8140 (if (markdown-link-p) 8141 (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) 8142 (markdown--browse-url (markdown-link-url))) 8143 (user-error "Point is not at a Markdown link or URL"))) 8144 8145 (defun markdown-fontify-inline-links (last) 8146 "Add text properties to next inline link from point to LAST." 8147 (when (markdown-match-generic-links last nil) 8148 (let* ((link-start (match-beginning 3)) 8149 (link-end (match-end 3)) 8150 (url-start (match-beginning 6)) 8151 (url-end (match-end 6)) 8152 (url (match-string-no-properties 6)) 8153 (title-start (match-beginning 7)) 8154 (title-end (match-end 7)) 8155 (title (match-string-no-properties 7)) 8156 ;; Markup part 8157 (mp (list 'invisible 'markdown-markup 8158 'rear-nonsticky t 8159 'font-lock-multiline t)) 8160 ;; Link part (without face) 8161 (lp (list 'keymap markdown-mode-mouse-map 8162 'mouse-face 'markdown-highlight-face 8163 'font-lock-multiline t 8164 'help-echo (if title (concat title "\n" url) url))) 8165 ;; URL part 8166 (up (list 'keymap markdown-mode-mouse-map 8167 'invisible 'markdown-markup 8168 'mouse-face 'markdown-highlight-face 8169 'font-lock-multiline t)) 8170 ;; URL composition character 8171 (url-char (markdown--first-displayable markdown-url-compose-char)) 8172 ;; Title part 8173 (tp (list 'invisible 'markdown-markup 8174 'font-lock-multiline t))) 8175 (dolist (g '(1 2 4 5 8)) 8176 (when (match-end g) 8177 (add-text-properties (match-beginning g) (match-end g) mp) 8178 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8179 ;; Preserve existing faces applied to link part (e.g., inline code) 8180 (when link-start 8181 (add-text-properties link-start link-end lp) 8182 (add-face-text-property link-start link-end 'markdown-link-face)) 8183 (when url-start 8184 (add-text-properties url-start url-end up) 8185 (add-face-text-property url-start url-end 'markdown-url-face)) 8186 (when title-start 8187 (add-text-properties url-end title-end tp) 8188 (add-face-text-property url-end title-end 'markdown-link-title-face)) 8189 (when (and markdown-hide-urls url-start) 8190 (compose-region url-start (or title-end url-end) url-char)) 8191 t))) 8192 8193 (defun markdown-fontify-reference-links (last) 8194 "Add text properties to next reference link from point to LAST." 8195 (when (markdown-match-generic-links last t) 8196 (let* ((link-start (match-beginning 3)) 8197 (link-end (match-end 3)) 8198 (ref-start (match-beginning 6)) 8199 (ref-end (match-end 6)) 8200 ;; Markup part 8201 (mp (list 'invisible 'markdown-markup 8202 'rear-nonsticky t 8203 'font-lock-multiline t)) 8204 ;; Link part 8205 (lp (list 'keymap markdown-mode-mouse-map 8206 'mouse-face 'markdown-highlight-face 8207 'font-lock-multiline t 8208 'help-echo (lambda (_ __ pos) 8209 (save-match-data 8210 (save-excursion 8211 (goto-char pos) 8212 (or (markdown-link-url) 8213 "Undefined reference")))))) 8214 ;; URL composition character 8215 (url-char (markdown--first-displayable markdown-url-compose-char)) 8216 ;; Reference part 8217 (rp (list 'invisible 'markdown-markup 8218 'font-lock-multiline t))) 8219 (dolist (g '(1 2 4 5 8)) 8220 (when (match-end g) 8221 (add-text-properties (match-beginning g) (match-end g) mp) 8222 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8223 (when link-start 8224 (add-text-properties link-start link-end lp) 8225 (add-face-text-property link-start link-end 'markdown-link-face)) 8226 (when ref-start 8227 (add-text-properties ref-start ref-end rp) 8228 (add-face-text-property ref-start ref-end 'markdown-reference-face) 8229 (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) 8230 (compose-region ref-start ref-end url-char))) 8231 t))) 8232 8233 (defun markdown-fontify-angle-uris (last) 8234 "Add text properties to angle URIs from point to LAST." 8235 (when (markdown-match-angle-uris last) 8236 (let* ((url-start (match-beginning 2)) 8237 (url-end (match-end 2)) 8238 ;; Markup part 8239 (mp (list 'face 'markdown-markup-face 8240 'invisible 'markdown-markup 8241 'rear-nonsticky t 8242 'font-lock-multiline t)) 8243 ;; URI part 8244 (up (list 'keymap markdown-mode-mouse-map 8245 'face 'markdown-plain-url-face 8246 'mouse-face 'markdown-highlight-face 8247 'font-lock-multiline t))) 8248 (dolist (g '(1 3)) 8249 (add-text-properties (match-beginning g) (match-end g) mp)) 8250 (add-text-properties url-start url-end up) 8251 t))) 8252 8253 (defun markdown-fontify-plain-uris (last) 8254 "Add text properties to plain URLs from point to LAST." 8255 (when (markdown-match-plain-uris last) 8256 (let* ((start (match-beginning 0)) 8257 (end (match-end 0)) 8258 (props (list 'keymap markdown-mode-mouse-map 8259 'face 'markdown-plain-url-face 8260 'mouse-face 'markdown-highlight-face 8261 'rear-nonsticky t 8262 'font-lock-multiline t))) 8263 (add-text-properties start end props) 8264 t))) 8265 8266 (defun markdown-toggle-url-hiding (&optional arg) 8267 "Toggle the display or hiding of URLs. 8268 With a prefix argument ARG, enable URL hiding if ARG is positive, 8269 and disable it otherwise." 8270 (interactive (list (or current-prefix-arg 'toggle))) 8271 (setq markdown-hide-urls 8272 (if (eq arg 'toggle) 8273 (not markdown-hide-urls) 8274 (> (prefix-numeric-value arg) 0))) 8275 (when (called-interactively-p 'interactive) 8276 (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) 8277 (markdown-reload-extensions)) 8278 8279 8280 ;;; Wiki Links ================================================================ 8281 8282 (defun markdown-wiki-link-p () 8283 "Return non-nil if wiki links are enabled and `point' is at a true wiki link. 8284 A true wiki link name matches `markdown-regex-wiki-link' but does 8285 not match the current file name after conversion. This modifies 8286 the data returned by `match-data'. Note that the potential wiki 8287 link name must be available via `match-string'." 8288 (when markdown-enable-wiki-links 8289 (let ((case-fold-search nil)) 8290 (and (thing-at-point-looking-at markdown-regex-wiki-link) 8291 (not (markdown-code-block-at-point-p)) 8292 (or (not buffer-file-name) 8293 (not (string-equal (buffer-file-name) 8294 (markdown-convert-wiki-link-to-filename 8295 (markdown-wiki-link-link))))))))) 8296 8297 (defun markdown-wiki-link-link () 8298 "Return the link part of the wiki link using current match data. 8299 The location of the link component depends on the value of 8300 `markdown-wiki-link-alias-first'." 8301 (if markdown-wiki-link-alias-first 8302 (or (match-string-no-properties 5) (match-string-no-properties 3)) 8303 (match-string-no-properties 3))) 8304 8305 (defun markdown-wiki-link-alias () 8306 "Return the alias or text part of the wiki link using current match data. 8307 The location of the alias component depends on the value of 8308 `markdown-wiki-link-alias-first'." 8309 (if markdown-wiki-link-alias-first 8310 (match-string-no-properties 3) 8311 (or (match-string-no-properties 5) (match-string-no-properties 3)))) 8312 8313 (defun markdown--wiki-link-search-types () 8314 (let ((ret (and markdown-wiki-link-search-type 8315 (cl-copy-list markdown-wiki-link-search-type)))) 8316 (when (and markdown-wiki-link-search-subdirectories 8317 (not (memq 'sub-directories markdown-wiki-link-search-type))) 8318 (push 'sub-directories ret)) 8319 (when (and markdown-wiki-link-search-parent-directories 8320 (not (memq 'parent-directories markdown-wiki-link-search-type))) 8321 (push 'parent-directories ret)) 8322 ret)) 8323 8324 (defun markdown--project-root () 8325 (or (cl-loop for dir in '(".git" ".hg" ".svn") 8326 when (locate-dominating-file default-directory dir) 8327 return it) 8328 (progn 8329 (require 'project) 8330 (let ((project (project-current t))) 8331 (with-no-warnings 8332 (if (fboundp 'project-root) 8333 (project-root project) 8334 (car (project-roots project)))))))) 8335 8336 (defun markdown-convert-wiki-link-to-filename (name) 8337 "Generate a filename from the wiki link NAME. 8338 Spaces in NAME are replaced with `markdown-link-space-sub-char'. 8339 When in `gfm-mode', follow GitHub's conventions where [[Test Test]] 8340 and [[test test]] both map to Test-test.ext. Look in the current 8341 directory first, then in subdirectories if 8342 `markdown-wiki-link-search-subdirectories' is non-nil, and then 8343 in parent directories if 8344 `markdown-wiki-link-search-parent-directories' is non-nil." 8345 (save-match-data 8346 ;; This function must not overwrite match data(PR #590) 8347 (let* ((basename (replace-regexp-in-string 8348 "[[:space:]\n]" markdown-link-space-sub-char name)) 8349 (basename (if (derived-mode-p 'gfm-mode) 8350 (concat (upcase (substring basename 0 1)) 8351 (downcase (substring basename 1 nil))) 8352 basename)) 8353 (search-types (markdown--wiki-link-search-types)) 8354 directory extension default candidates dir) 8355 (when buffer-file-name 8356 (setq directory (file-name-directory buffer-file-name) 8357 extension (file-name-extension buffer-file-name))) 8358 (setq default (concat basename 8359 (when extension (concat "." extension)))) 8360 (cond 8361 ;; Look in current directory first. 8362 ((or (null buffer-file-name) 8363 (file-exists-p default)) 8364 default) 8365 ;; Possibly search in subdirectories, next. 8366 ((and (memq 'sub-directories search-types) 8367 (setq candidates 8368 (directory-files-recursively 8369 directory (concat "^" default "$")))) 8370 (car candidates)) 8371 ;; Possibly search in parent directories as a last resort. 8372 ((and (memq 'parent-directories search-types) 8373 (setq dir (locate-dominating-file directory default))) 8374 (concat dir default)) 8375 ((and (memq 'project search-types) 8376 (setq candidates 8377 (directory-files-recursively 8378 (markdown--project-root) (concat "^" default "$")))) 8379 (car candidates)) 8380 ;; If nothing is found, return default in current directory. 8381 (t default))))) 8382 8383 (defun markdown-follow-wiki-link (name &optional other) 8384 "Follow the wiki link NAME. 8385 Convert the name to a file name and call `find-file'. Ensure that 8386 the new buffer remains in `markdown-mode'. Open the link in another 8387 window when OTHER is non-nil." 8388 (let ((filename (markdown-convert-wiki-link-to-filename name)) 8389 (wp (when buffer-file-name 8390 (file-name-directory buffer-file-name)))) 8391 (if (not wp) 8392 (user-error "Must be visiting a file") 8393 (when other (other-window 1)) 8394 (let ((default-directory wp)) 8395 (find-file filename))) 8396 (unless (derived-mode-p 'markdown-mode) 8397 (markdown-mode)))) 8398 8399 (defun markdown-follow-wiki-link-at-point (&optional arg) 8400 "Find Wiki Link at point. 8401 With prefix argument ARG, open the file in other window. 8402 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." 8403 (interactive "P") 8404 (if (markdown-wiki-link-p) 8405 (markdown-follow-wiki-link (markdown-wiki-link-link) arg) 8406 (user-error "Point is not at a Wiki Link"))) 8407 8408 (defun markdown-highlight-wiki-link (from to face) 8409 "Highlight the wiki link in the region between FROM and TO using FACE." 8410 (put-text-property from to 'font-lock-face face)) 8411 8412 (defun markdown-unfontify-region-wiki-links (from to) 8413 "Remove wiki link faces from the region specified by FROM and TO." 8414 (interactive "*r") 8415 (let ((modified (buffer-modified-p))) 8416 (remove-text-properties from to '(font-lock-face markdown-link-face)) 8417 (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) 8418 ;; remove-text-properties marks the buffer modified in emacs 24.3, 8419 ;; undo that if it wasn't originally marked modified 8420 (set-buffer-modified-p modified))) 8421 8422 (defun markdown-fontify-region-wiki-links (from to) 8423 "Search region given by FROM and TO for wiki links and fontify them. 8424 If a wiki link is found check to see if the backing file exists 8425 and highlight accordingly." 8426 (goto-char from) 8427 (save-match-data 8428 (while (re-search-forward markdown-regex-wiki-link to t) 8429 (when (not (markdown-code-block-at-point-p)) 8430 (let ((highlight-beginning (match-beginning 1)) 8431 (highlight-end (match-end 1)) 8432 (file-name 8433 (markdown-convert-wiki-link-to-filename 8434 (markdown-wiki-link-link)))) 8435 (if (condition-case nil (file-exists-p file-name) (error nil)) 8436 (markdown-highlight-wiki-link 8437 highlight-beginning highlight-end 'markdown-link-face) 8438 (markdown-highlight-wiki-link 8439 highlight-beginning highlight-end 'markdown-missing-link-face))))))) 8440 8441 (defun markdown-extend-changed-region (from to) 8442 "Extend region given by FROM and TO so that we can fontify all links. 8443 The region is extended to the first newline before and the first 8444 newline after." 8445 ;; start looking for the first new line before 'from 8446 (goto-char from) 8447 (re-search-backward "\n" nil t) 8448 (let ((new-from (point-min)) 8449 (new-to (point-max))) 8450 (if (not (= (point) from)) 8451 (setq new-from (point))) 8452 ;; do the same thing for the first new line after 'to 8453 (goto-char to) 8454 (re-search-forward "\n" nil t) 8455 (if (not (= (point) to)) 8456 (setq new-to (point))) 8457 (cl-values new-from new-to))) 8458 8459 (defun markdown-check-change-for-wiki-link (from to) 8460 "Check region between FROM and TO for wiki links and re-fontify as needed." 8461 (interactive "*r") 8462 (let* ((modified (buffer-modified-p)) 8463 (buffer-undo-list t) 8464 (inhibit-read-only t) 8465 deactivate-mark 8466 buffer-file-truename) 8467 (unwind-protect 8468 (save-excursion 8469 (save-match-data 8470 (save-restriction 8471 (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 8472 ;; Extend the region to fontify so that it starts 8473 ;; and ends at safe places. 8474 (cl-multiple-value-bind (new-from new-to) 8475 (markdown-extend-changed-region from to) 8476 (goto-char new-from) 8477 ;; Only refontify when the range contains text with a 8478 ;; wiki link face or if the wiki link regexp matches. 8479 (when (or (markdown-range-property-any 8480 new-from new-to 'font-lock-face 8481 '(markdown-link-face markdown-missing-link-face)) 8482 (re-search-forward 8483 markdown-regex-wiki-link new-to t)) 8484 ;; Unfontify existing fontification (start from scratch) 8485 (markdown-unfontify-region-wiki-links new-from new-to) 8486 ;; Now do the fontification. 8487 (markdown-fontify-region-wiki-links new-from new-to)))))) 8488 (cursor-intangible-mode -1) 8489 (and (not modified) 8490 (buffer-modified-p) 8491 (set-buffer-modified-p nil))))) 8492 8493 (defun markdown-check-change-for-wiki-link-after-change (from to _) 8494 "Check region between FROM and TO for wiki links and re-fontify as needed. 8495 Designed to be used with the `after-change-functions' hook." 8496 (markdown-check-change-for-wiki-link from to)) 8497 8498 (defun markdown-fontify-buffer-wiki-links () 8499 "Refontify all wiki links in the buffer." 8500 (interactive) 8501 (markdown-check-change-for-wiki-link (point-min) (point-max))) 8502 8503 (defun markdown-toggle-wiki-links (&optional arg) 8504 "Toggle support for wiki links. 8505 With a prefix argument ARG, enable wiki link support if ARG is positive, 8506 and disable it otherwise." 8507 (interactive (list (or current-prefix-arg 'toggle))) 8508 (setq markdown-enable-wiki-links 8509 (if (eq arg 'toggle) 8510 (not markdown-enable-wiki-links) 8511 (> (prefix-numeric-value arg) 0))) 8512 (when (called-interactively-p 'interactive) 8513 (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) 8514 (markdown-reload-extensions)) 8515 8516 (defun markdown-setup-wiki-link-hooks () 8517 "Add or remove hooks for fontifying wiki links. 8518 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." 8519 ;; Anytime text changes make sure it gets fontified correctly 8520 (if (and markdown-enable-wiki-links 8521 markdown-wiki-link-fontify-missing) 8522 (add-hook 'after-change-functions 8523 #'markdown-check-change-for-wiki-link-after-change t t) 8524 (remove-hook 'after-change-functions 8525 #'markdown-check-change-for-wiki-link-after-change t)) 8526 ;; If we left the buffer there is a really good chance we were 8527 ;; creating one of the wiki link documents. Make sure we get 8528 ;; refontified when we come back. 8529 (if (and markdown-enable-wiki-links 8530 markdown-wiki-link-fontify-missing) 8531 (progn 8532 (add-hook 'window-configuration-change-hook 8533 #'markdown-fontify-buffer-wiki-links t t) 8534 (markdown-fontify-buffer-wiki-links)) 8535 (remove-hook 'window-configuration-change-hook 8536 #'markdown-fontify-buffer-wiki-links t) 8537 (markdown-unfontify-region-wiki-links (point-min) (point-max)))) 8538 8539 8540 ;;; Following & Doing ========================================================= 8541 8542 (defun markdown-follow-thing-at-point (arg) 8543 "Follow thing at point if possible, such as a reference link or wiki link. 8544 Opens inline and reference links in a browser. Opens wiki links 8545 to other files in the current window, or the another window if 8546 ARG is non-nil. 8547 See `markdown-follow-link-at-point' and 8548 `markdown-follow-wiki-link-at-point'." 8549 (interactive "P") 8550 (cond ((markdown-link-p) 8551 (markdown-follow-link-at-point)) 8552 ((markdown-wiki-link-p) 8553 (markdown-follow-wiki-link-at-point arg)) 8554 (t 8555 (let* ((values (markdown-link-at-pos (point))) 8556 (url (nth 3 values))) 8557 (unless url 8558 (user-error "Nothing to follow at point")) 8559 (markdown--browse-url url))))) 8560 8561 (defun markdown-do () 8562 "Do something sensible based on context at point. 8563 Jumps between reference links and definitions; between footnote 8564 markers and footnote text." 8565 (interactive) 8566 (cond 8567 ;; Footnote definition 8568 ((markdown-footnote-text-positions) 8569 (markdown-footnote-return)) 8570 ;; Footnote marker 8571 ((markdown-footnote-marker-positions) 8572 (markdown-footnote-goto-text)) 8573 ;; Reference link 8574 ((thing-at-point-looking-at markdown-regex-link-reference) 8575 (markdown-reference-goto-definition)) 8576 ;; Reference definition 8577 ((thing-at-point-looking-at markdown-regex-reference-definition) 8578 (markdown-reference-goto-link (match-string-no-properties 2))) 8579 ;; Link 8580 ((or (markdown-link-p) (markdown-wiki-link-p)) 8581 (markdown-follow-thing-at-point nil)) 8582 ;; GFM task list item 8583 ((markdown-gfm-task-list-item-at-point) 8584 (markdown-toggle-gfm-checkbox)) 8585 ;; Align table 8586 ((markdown-table-at-point-p) 8587 (call-interactively #'markdown-table-align)) 8588 ;; Otherwise 8589 (t 8590 (markdown-insert-gfm-checkbox)))) 8591 8592 8593 ;;; Miscellaneous ============================================================= 8594 8595 (defun markdown-compress-whitespace-string (str) 8596 "Compress whitespace in STR and return result. 8597 Leading and trailing whitespace is removed. Sequences of multiple 8598 spaces, tabs, and newlines are replaced with single spaces." 8599 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" 8600 (replace-regexp-in-string "[ \t\n]+" " " str))) 8601 8602 (defun markdown--substitute-command-keys (string) 8603 "Like `substitute-command-keys' but, but prefers control characters. 8604 First pass STRING to `substitute-command-keys' and then 8605 substitute `C-i` for `TAB` and `C-m` for `RET`." 8606 (replace-regexp-in-string 8607 "\\<TAB\\>" "C-i" 8608 (replace-regexp-in-string 8609 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) 8610 8611 (defun markdown-line-number-at-pos (&optional pos) 8612 "Return (narrowed) buffer line number at position POS. 8613 If POS is nil, use current buffer location. 8614 This is an exact copy of `line-number-at-pos' for use in emacs21." 8615 (let ((opoint (or pos (point))) start) 8616 (save-excursion 8617 (goto-char (point-min)) 8618 (setq start (point)) 8619 (goto-char opoint) 8620 (forward-line 0) 8621 (1+ (count-lines start (point)))))) 8622 8623 (defun markdown-inside-link-p () 8624 "Return t if point is within a link." 8625 (save-match-data 8626 (thing-at-point-looking-at (markdown-make-regex-link-generic)))) 8627 8628 (defun markdown-line-is-reference-definition-p () 8629 "Return whether the current line is a (non-footnote) reference definition." 8630 (save-excursion 8631 (move-beginning-of-line 1) 8632 (and (looking-at-p markdown-regex-reference-definition) 8633 (not (looking-at-p "[ \t]*\\[^"))))) 8634 8635 (defun markdown-adaptive-fill-function () 8636 "Return prefix for filling paragraph or nil if not determined." 8637 (cond 8638 ;; List item inside blockquote 8639 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") 8640 (replace-regexp-in-string 8641 "[0-9\\.*+-]" " " (match-string-no-properties 0))) 8642 ;; Blockquote 8643 ((looking-at markdown-regex-blockquote) 8644 (buffer-substring-no-properties (match-beginning 0) (match-end 2))) 8645 ;; List items 8646 ((looking-at markdown-regex-list) 8647 (match-string-no-properties 0)) 8648 ;; Footnote definition 8649 ((looking-at-p markdown-regex-footnote-definition) 8650 " ") ; four spaces 8651 ;; No match 8652 (t nil))) 8653 8654 (defun markdown-fill-paragraph (&optional justify) 8655 "Fill paragraph at or after point. 8656 This function is like \\[fill-paragraph], but it skips Markdown 8657 code blocks. If the point is in a code block, or just before one, 8658 do not fill. Otherwise, call `fill-paragraph' as usual. If 8659 JUSTIFY is non-nil, justify text as well. Since this function 8660 handles filling itself, it always returns t so that 8661 `fill-paragraph' doesn't run." 8662 (interactive "P") 8663 (unless (or (markdown-code-block-at-point-p) 8664 (save-excursion 8665 (back-to-indentation) 8666 (skip-syntax-forward "-") 8667 (markdown-code-block-at-point-p))) 8668 (let ((fill-prefix (save-excursion 8669 (goto-char (line-beginning-position)) 8670 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") 8671 (match-string-no-properties 1))))) 8672 (fill-paragraph justify))) 8673 t) 8674 8675 (defun markdown-fill-forward-paragraph (&optional arg) 8676 "Function used by `fill-paragraph' to move over ARG paragraphs. 8677 This is a `fill-forward-paragraph-function' for `markdown-mode'. 8678 It is called with a single argument specifying the number of 8679 paragraphs to move. Just like `forward-paragraph', it should 8680 return the number of paragraphs left to move." 8681 (or arg (setq arg 1)) 8682 (if (> arg 0) 8683 ;; With positive ARG, move across ARG non-code-block paragraphs, 8684 ;; one at a time. When passing a code block, don't decrement ARG. 8685 (while (and (not (eobp)) 8686 (> arg 0) 8687 (= (forward-paragraph 1) 0) 8688 (or (markdown-code-block-at-pos (line-beginning-position 0)) 8689 (setq arg (1- arg))))) 8690 ;; Move backward by one paragraph with negative ARG (always -1). 8691 (let ((start (point))) 8692 (setq arg (forward-paragraph arg)) 8693 (while (and (not (eobp)) 8694 (progn (move-to-left-margin) (not (eobp))) 8695 (looking-at-p paragraph-separate)) 8696 (forward-line 1)) 8697 (cond 8698 ;; Move point past whitespace following list marker. 8699 ((looking-at markdown-regex-list) 8700 (goto-char (match-end 0))) 8701 ;; Move point past whitespace following pipe at beginning of line 8702 ;; to handle Pandoc line blocks. 8703 ((looking-at "^|\\s-*") 8704 (goto-char (match-end 0))) 8705 ;; Return point if the paragraph passed was a code block. 8706 ((markdown-code-block-at-pos (line-beginning-position 2)) 8707 (goto-char start))))) 8708 arg) 8709 8710 (defun markdown--inhibit-electric-quote () 8711 "Function added to `electric-quote-inhibit-functions'. 8712 Return non-nil if the quote has been inserted inside a code block 8713 or span." 8714 (let ((pos (1- (point)))) 8715 (or (markdown-inline-code-at-pos pos) 8716 (markdown-code-block-at-pos pos)))) 8717 8718 8719 ;;; Extension Framework ======================================================= 8720 8721 (defun markdown-reload-extensions () 8722 "Check settings, update font-lock keywords and hooks, and re-fontify buffer." 8723 (interactive) 8724 (when (derived-mode-p 'markdown-mode) 8725 ;; Refontify buffer 8726 (font-lock-flush) 8727 ;; Add or remove hooks related to extensions 8728 (markdown-setup-wiki-link-hooks))) 8729 8730 (defun markdown-handle-local-variables () 8731 "Run in `hack-local-variables-hook' to update font lock rules. 8732 Checks to see if there is actually a ‘markdown-mode’ file local variable 8733 before regenerating font-lock rules for extensions." 8734 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) 8735 (assoc 'markdown-enable-math file-local-variables-alist)) 8736 (when (assoc 'markdown-enable-math file-local-variables-alist) 8737 (markdown-toggle-math markdown-enable-math)) 8738 (markdown-reload-extensions))) 8739 8740 8741 ;;; Math Support ============================================================== 8742 8743 (defconst markdown-mode-font-lock-keywords-math 8744 (list 8745 ;; Equation reference (eq:foo) 8746 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) 8747 (2 markdown-reference-face) 8748 (3 markdown-markup-face))) 8749 ;; Equation reference \eqref{foo} 8750 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) 8751 (2 markdown-reference-face) 8752 (3 markdown-markup-face)))) 8753 "Font lock keywords to add and remove when toggling math support.") 8754 8755 (defun markdown-toggle-math (&optional arg) 8756 "Toggle support for inline and display LaTeX math expressions. 8757 With a prefix argument ARG, enable math mode if ARG is positive, 8758 and disable it otherwise. If called from Lisp, enable the mode 8759 if ARG is omitted or nil." 8760 (interactive (list (or current-prefix-arg 'toggle))) 8761 (setq markdown-enable-math 8762 (if (eq arg 'toggle) 8763 (not markdown-enable-math) 8764 (> (prefix-numeric-value arg) 0))) 8765 (if markdown-enable-math 8766 (font-lock-add-keywords 8767 'markdown-mode markdown-mode-font-lock-keywords-math) 8768 (font-lock-remove-keywords 8769 'markdown-mode markdown-mode-font-lock-keywords-math)) 8770 (when (called-interactively-p 'interactive) 8771 (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) 8772 (markdown-reload-extensions)) 8773 8774 8775 ;;; GFM Checkboxes ============================================================ 8776 8777 (define-button-type 'markdown-gfm-checkbox-button 8778 'follow-link t 8779 'face 'markdown-gfm-checkbox-face 8780 'mouse-face 'markdown-highlight-face 8781 'action #'markdown-toggle-gfm-checkbox-button) 8782 8783 (defun markdown-gfm-task-list-item-at-point (&optional bounds) 8784 "Return non-nil if there is a GFM task list item at the point. 8785 Optionally, the list item BOUNDS may be given if available, as 8786 returned by `markdown-cur-list-item-bounds'. When a task list item 8787 is found, the return value is the same value returned by 8788 `markdown-cur-list-item-bounds'." 8789 (unless bounds 8790 (setq bounds (markdown-cur-list-item-bounds))) 8791 (> (length (nth 5 bounds)) 0)) 8792 8793 (defun markdown-insert-gfm-checkbox () 8794 "Add GFM checkbox at point. 8795 Returns t if added. 8796 Returns nil if non-applicable." 8797 (interactive) 8798 (let ((bounds (markdown-cur-list-item-bounds))) 8799 (if bounds 8800 (unless (cl-sixth bounds) 8801 (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) 8802 (markup "[ ] ")) 8803 (if (< pos (point)) 8804 (save-excursion 8805 (goto-char pos) 8806 (insert markup)) 8807 (goto-char pos) 8808 (insert markup)) 8809 (syntax-propertize (+ (cl-second bounds) 4)) 8810 t)) 8811 (unless (save-excursion 8812 (back-to-indentation) 8813 (or (markdown-list-item-at-point-p) 8814 (markdown-heading-at-point) 8815 (markdown-in-comment-p) 8816 (markdown-code-block-at-point-p))) 8817 (let ((pos (save-excursion 8818 (back-to-indentation) 8819 (point))) 8820 (markup (concat (or (save-excursion 8821 (beginning-of-line 0) 8822 (cl-fifth (markdown-cur-list-item-bounds))) 8823 markdown-unordered-list-item-prefix) 8824 "[ ] "))) 8825 (if (< pos (point)) 8826 (save-excursion 8827 (goto-char pos) 8828 (insert markup)) 8829 (goto-char pos) 8830 (insert markup)) 8831 (syntax-propertize (line-end-position)) 8832 t))))) 8833 8834 (defun markdown-toggle-gfm-checkbox () 8835 "Toggle GFM checkbox at point. 8836 Returns the resulting status as a string, either \"[x]\" or \"[ ]\". 8837 Returns nil if there is no task list item at the point." 8838 (interactive) 8839 (save-match-data 8840 (save-excursion 8841 (let ((bounds (markdown-cur-list-item-bounds))) 8842 (when bounds 8843 ;; Move to beginning of task list item 8844 (goto-char (cl-first bounds)) 8845 ;; Advance to column of first non-whitespace after marker 8846 (forward-char (cl-fourth bounds)) 8847 (cond ((looking-at "\\[ \\]") 8848 (replace-match 8849 (if markdown-gfm-uppercase-checkbox "[X]" "[x]") 8850 nil t) 8851 (match-string-no-properties 0)) 8852 ((looking-at "\\[[xX]\\]") 8853 (replace-match "[ ]" nil t) 8854 (match-string-no-properties 0)))))))) 8855 8856 (defun markdown-toggle-gfm-checkbox-button (button) 8857 "Toggle GFM checkbox BUTTON on click." 8858 (save-match-data 8859 (save-excursion 8860 (goto-char (button-start button)) 8861 (markdown-toggle-gfm-checkbox)))) 8862 8863 (defun markdown-make-gfm-checkboxes-buttons (start end) 8864 "Make GFM checkboxes buttons in region between START and END." 8865 (save-excursion 8866 (goto-char start) 8867 (let ((case-fold-search t)) 8868 (save-excursion 8869 (while (re-search-forward markdown-regex-gfm-checkbox end t) 8870 (make-button (match-beginning 1) (match-end 1) 8871 :type 'markdown-gfm-checkbox-button)))))) 8872 8873 ;; Called when any modification is made to buffer text. 8874 (defun markdown-gfm-checkbox-after-change-function (beg end _) 8875 "Add to `after-change-functions' to setup GFM checkboxes as buttons. 8876 BEG and END are the limits of scanned region." 8877 (save-excursion 8878 (save-match-data 8879 ;; Rescan between start of line from `beg' and start of line after `end'. 8880 (markdown-make-gfm-checkboxes-buttons 8881 (progn (goto-char beg) (beginning-of-line) (point)) 8882 (progn (goto-char end) (forward-line 1) (point)))))) 8883 8884 (defun markdown-remove-gfm-checkbox-overlays () 8885 "Remove all GFM checkbox overlays in buffer." 8886 (save-excursion 8887 (save-restriction 8888 (widen) 8889 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) 8890 8891 8892 ;;; Display inline image ====================================================== 8893 8894 (defvar-local markdown-inline-image-overlays nil) 8895 8896 (defun markdown-remove-inline-images () 8897 "Remove inline image overlays from image links in the buffer. 8898 This can be toggled with `markdown-toggle-inline-images' 8899 or \\[markdown-toggle-inline-images]." 8900 (interactive) 8901 (mapc #'delete-overlay markdown-inline-image-overlays) 8902 (setq markdown-inline-image-overlays nil) 8903 (when (fboundp 'clear-image-cache) (clear-image-cache))) 8904 8905 (defcustom markdown-display-remote-images nil 8906 "If non-nil, download and display remote images. 8907 See also `markdown-inline-image-overlays'. 8908 8909 Only image URLs specified with a protocol listed in 8910 `markdown-remote-image-protocols' are displayed." 8911 :group 'markdown 8912 :type 'boolean) 8913 8914 (defcustom markdown-remote-image-protocols '("https") 8915 "List of protocols to use to download remote images. 8916 See also `markdown-display-remote-images'." 8917 :group 'markdown 8918 :type '(repeat string)) 8919 8920 (defvar markdown--remote-image-cache 8921 (make-hash-table :test 'equal) 8922 "A map from URLs to image paths.") 8923 8924 (defun markdown--get-remote-image (url) 8925 "Retrieve the image path for a given URL." 8926 (or (gethash url markdown--remote-image-cache) 8927 (let ((dl-path (make-temp-file "markdown-mode--image"))) 8928 (require 'url) 8929 (url-copy-file url dl-path t) 8930 (puthash url dl-path markdown--remote-image-cache)))) 8931 8932 (defun markdown-display-inline-images () 8933 "Add inline image overlays to image links in the buffer. 8934 This can be toggled with `markdown-toggle-inline-images' 8935 or \\[markdown-toggle-inline-images]." 8936 (interactive) 8937 (unless (display-images-p) 8938 (error "Cannot show images")) 8939 (save-excursion 8940 (save-restriction 8941 (widen) 8942 (goto-char (point-min)) 8943 (while (re-search-forward markdown-regex-link-inline nil t) 8944 (let* ((start (match-beginning 0)) 8945 (imagep (match-beginning 1)) 8946 (end (match-end 0)) 8947 (file (match-string-no-properties 6))) 8948 (when (and imagep 8949 (not (zerop (length file)))) 8950 (unless (file-exists-p file) 8951 (let* ((download-file (funcall markdown-translate-filename-function file)) 8952 (valid-url (ignore-errors 8953 (member (downcase (url-type (url-generic-parse-url download-file))) 8954 markdown-remote-image-protocols)))) 8955 (if (and markdown-display-remote-images valid-url) 8956 (setq file (markdown--get-remote-image download-file)) 8957 (when (not valid-url) 8958 ;; strip query parameter 8959 (setq file (replace-regexp-in-string "?.+\\'" "" file)) 8960 (unless (file-exists-p file) 8961 (setq file (url-unhex-string file))))))) 8962 (when (file-exists-p file) 8963 (let* ((abspath (if (file-name-absolute-p file) 8964 file 8965 (concat default-directory file))) 8966 (image 8967 (cond ((and markdown-max-image-size 8968 (image-type-available-p 'imagemagick)) 8969 (create-image 8970 abspath 'imagemagick nil 8971 :max-width (car markdown-max-image-size) 8972 :max-height (cdr markdown-max-image-size))) 8973 (markdown-max-image-size 8974 (create-image abspath nil nil 8975 :max-width (car markdown-max-image-size) 8976 :max-height (cdr markdown-max-image-size))) 8977 (t (create-image abspath))))) 8978 (when image 8979 (let ((ov (make-overlay start end))) 8980 (overlay-put ov 'display image) 8981 (overlay-put ov 'face 'default) 8982 (push ov markdown-inline-image-overlays))))))))))) 8983 8984 (defun markdown-toggle-inline-images () 8985 "Toggle inline image overlays in the buffer." 8986 (interactive) 8987 (if markdown-inline-image-overlays 8988 (markdown-remove-inline-images) 8989 (markdown-display-inline-images))) 8990 8991 8992 ;;; GFM Code Block Fontification ============================================== 8993 8994 (defcustom markdown-fontify-code-blocks-natively nil 8995 "When non-nil, fontify code in code blocks using the native major mode. 8996 This only works for fenced code blocks where the language is 8997 specified where we can automatically determine the appropriate 8998 mode to use. The language to mode mapping may be customized by 8999 setting the variable `markdown-code-lang-modes'." 9000 :group 'markdown 9001 :type 'boolean 9002 :safe #'booleanp 9003 :package-version '(markdown-mode . "2.3")) 9004 9005 (defcustom markdown-fontify-code-block-default-mode nil 9006 "Default mode to use to fontify code blocks. 9007 This mode is used when automatic detection fails, such as for GFM 9008 code blocks with no language specified." 9009 :group 'markdown 9010 :type '(choice function (const :tag "None" nil)) 9011 :package-version '(markdown-mode . "2.4")) 9012 9013 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg) 9014 "Toggle the native fontification of code blocks. 9015 With a prefix argument ARG, enable if ARG is positive, 9016 and disable otherwise." 9017 (interactive (list (or current-prefix-arg 'toggle))) 9018 (setq markdown-fontify-code-blocks-natively 9019 (if (eq arg 'toggle) 9020 (not markdown-fontify-code-blocks-natively) 9021 (> (prefix-numeric-value arg) 0))) 9022 (when (called-interactively-p 'interactive) 9023 (message "markdown-mode native code block fontification %s" 9024 (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) 9025 (markdown-reload-extensions)) 9026 9027 ;; This is based on `org-src-lang-modes' from org-src.el 9028 (defcustom markdown-code-lang-modes 9029 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) 9030 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) 9031 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) 9032 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) 9033 ("bash" . sh-mode)) 9034 "Alist mapping languages to their major mode. 9035 The key is the language name, the value is the major mode. For 9036 many languages this is simple, but for language where this is not 9037 the case, this variable provides a way to simplify things on the 9038 user side. For example, there is no ocaml-mode in Emacs, but the 9039 mode to use is `tuareg-mode'." 9040 :group 'markdown 9041 :type '(repeat 9042 (cons 9043 (string "Language name") 9044 (symbol "Major mode"))) 9045 :package-version '(markdown-mode . "2.3")) 9046 9047 (defun markdown-get-lang-mode (lang) 9048 "Return major mode that should be used for LANG. 9049 LANG is a string, and the returned major mode is a symbol." 9050 (cl-find-if 9051 #'markdown--lang-mode-predicate 9052 (nconc (list (cdr (assoc lang markdown-code-lang-modes)) 9053 (cdr (assoc (downcase lang) markdown-code-lang-modes))) 9054 (and (fboundp 'treesit-language-available-p) 9055 (list (and (treesit-language-available-p (intern lang)) 9056 (intern (concat lang "-ts-mode"))) 9057 (and (treesit-language-available-p (intern (downcase lang))) 9058 (intern (concat (downcase lang) "-ts-mode"))))) 9059 (list 9060 (intern (concat lang "-mode")) 9061 (intern (concat (downcase lang) "-mode")))))) 9062 9063 (defun markdown--lang-mode-predicate (mode) 9064 (and mode 9065 (fboundp mode) 9066 (or 9067 ;; https://github.com/jrblevin/markdown-mode/issues/787 9068 ;; major-mode-remap-alist was introduced at Emacs 29.1 9069 (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) 9070 for func = (cdr pair) 9071 thereis (and (atom func) (eq mode func))) 9072 ;; https://github.com/jrblevin/markdown-mode/issues/761 9073 (cl-loop for pair in auto-mode-alist 9074 for func = (cdr pair) 9075 thereis (and (atom func) (eq mode func)))))) 9076 9077 (defun markdown-fontify-code-blocks-generic (matcher last) 9078 "Add text properties to next code block from point to LAST. 9079 Use matching function MATCHER." 9080 (when (funcall matcher last) 9081 (save-excursion 9082 (save-match-data 9083 (let* ((start (match-beginning 0)) 9084 (end (match-end 0)) 9085 ;; Find positions outside opening and closing backquotes. 9086 (bol-prev (progn (goto-char start) 9087 (if (bolp) (line-beginning-position 0) (line-beginning-position)))) 9088 (eol-next (progn (goto-char end) 9089 (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) 9090 lang) 9091 (if (and markdown-fontify-code-blocks-natively 9092 (or (setq lang (markdown-code-block-lang)) 9093 markdown-fontify-code-block-default-mode)) 9094 (markdown-fontify-code-block-natively lang start end) 9095 (add-text-properties start end '(face markdown-pre-face))) 9096 ;; Set background for block as well as opening and closing lines. 9097 (font-lock-append-text-property 9098 bol-prev eol-next 'face 'markdown-code-face) 9099 ;; Set invisible property for lines before and after, including newline. 9100 (add-text-properties bol-prev start '(invisible markdown-markup)) 9101 (add-text-properties end eol-next '(invisible markdown-markup))))) 9102 t)) 9103 9104 (defun markdown-fontify-gfm-code-blocks (last) 9105 "Add text properties to next GFM code block from point to LAST." 9106 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) 9107 9108 (defun markdown-fontify-fenced-code-blocks (last) 9109 "Add text properties to next tilde fenced code block from point to LAST." 9110 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) 9111 9112 ;; Based on `org-src-font-lock-fontify-block' from org-src.el. 9113 (defun markdown-fontify-code-block-natively (lang start end) 9114 "Fontify given GFM or fenced code block. 9115 This function is called by Emacs for automatic fontification when 9116 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the 9117 language used in the block. START and END specify the block 9118 position." 9119 (let ((lang-mode (if lang (markdown-get-lang-mode lang) 9120 markdown-fontify-code-block-default-mode))) 9121 (when (fboundp lang-mode) 9122 (let ((string (buffer-substring-no-properties start end)) 9123 (modified (buffer-modified-p)) 9124 (markdown-buffer (current-buffer)) pos next) 9125 (remove-text-properties start end '(face nil)) 9126 (with-current-buffer 9127 (get-buffer-create 9128 (concat " markdown-code-fontification:" (symbol-name lang-mode))) 9129 ;; Make sure that modification hooks are not inhibited in 9130 ;; the org-src-fontification buffer in case we're called 9131 ;; from `jit-lock-function' (Bug#25132). 9132 (let ((inhibit-modification-hooks nil)) 9133 (delete-region (point-min) (point-max)) 9134 (insert string " ")) ;; so there's a final property change 9135 (unless (eq major-mode lang-mode) (funcall lang-mode)) 9136 (font-lock-ensure) 9137 (setq pos (point-min)) 9138 (while (setq next (next-single-property-change pos 'face)) 9139 (let ((val (get-text-property pos 'face))) 9140 (when val 9141 (put-text-property 9142 (+ start (1- pos)) (1- (+ start next)) 'face 9143 val markdown-buffer))) 9144 (setq pos next))) 9145 (add-text-properties 9146 start end 9147 '(font-lock-fontified t fontified t font-lock-multiline t)) 9148 (set-buffer-modified-p modified))))) 9149 9150 (require 'edit-indirect nil t) 9151 (defvar edit-indirect-guess-mode-function) 9152 (defvar edit-indirect-after-commit-functions) 9153 9154 (defun markdown--edit-indirect-after-commit-function (beg end) 9155 "Corrective logic run on code block content from lines BEG to END. 9156 Restores code block indentation from BEG to END, and ensures trailing newlines 9157 at the END of code blocks." 9158 ;; ensure trailing newlines 9159 (goto-char end) 9160 (unless (eq (char-before) ?\n) 9161 (insert "\n")) 9162 ;; restore code block indentation 9163 (goto-char (- beg 1)) 9164 (let ((block-indentation (current-indentation))) 9165 (when (> block-indentation 0) 9166 (indent-rigidly beg end block-indentation))) 9167 (font-lock-ensure)) 9168 9169 (defun markdown-edit-code-block () 9170 "Edit Markdown code block in an indirect buffer." 9171 (interactive) 9172 (save-excursion 9173 (if (fboundp 'edit-indirect-region) 9174 (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) 9175 (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) 9176 (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) 9177 (if (and begin end) 9178 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) 9179 (lang (markdown-code-block-lang)) 9180 (mode (or (and lang (markdown-get-lang-mode lang)) 9181 markdown-edit-code-block-default-mode)) 9182 (edit-indirect-guess-mode-function 9183 (lambda (_parent-buffer _beg _end) 9184 (funcall mode))) 9185 (indirect-buf (edit-indirect-region begin end 'display-buffer))) 9186 ;; reset `sh-shell' when indirect buffer 9187 (when (and (not (member system-type '(ms-dos windows-nt))) 9188 (member mode '(shell-script-mode sh-mode)) 9189 (member lang (append 9190 (mapcar (lambda (e) (symbol-name (car e))) 9191 sh-ancestor-alist) 9192 '("csh" "rc" "sh")))) 9193 (with-current-buffer indirect-buf 9194 (sh-set-shell lang))) 9195 (when (> indentation 0) ;; un-indent in edit-indirect buffer 9196 (with-current-buffer indirect-buf 9197 (indent-rigidly (point-min) (point-max) (- indentation))))) 9198 (user-error "Not inside a GFM or tilde fenced code block"))) 9199 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") 9200 (progn (package-refresh-contents) 9201 (package-install 'edit-indirect) 9202 (markdown-edit-code-block)))))) 9203 9204 9205 ;;; Table Editing ============================================================= 9206 9207 ;; These functions were originally adapted from `org-table.el'. 9208 9209 ;; General helper functions 9210 9211 (defmacro markdown--with-gensyms (symbols &rest body) 9212 (declare (debug (sexp body)) (indent 1)) 9213 `(let ,(mapcar (lambda (s) 9214 `(,s (make-symbol (concat "--" (symbol-name ',s))))) 9215 symbols) 9216 ,@body)) 9217 9218 (defun markdown--split-string (string &optional separators) 9219 "Splits STRING into substrings at SEPARATORS. 9220 SEPARATORS is a regular expression. If nil it defaults to 9221 `split-string-default-separators'. This version returns no empty 9222 strings if there are matches at the beginning and end of string." 9223 (let ((start 0) notfirst list) 9224 (while (and (string-match 9225 (or separators split-string-default-separators) 9226 string 9227 (if (and notfirst 9228 (= start (match-beginning 0)) 9229 (< start (length string))) 9230 (1+ start) start)) 9231 (< (match-beginning 0) (length string))) 9232 (setq notfirst t) 9233 (or (eq (match-beginning 0) 0) 9234 (and (eq (match-beginning 0) (match-end 0)) 9235 (eq (match-beginning 0) start)) 9236 (push (substring string start (match-beginning 0)) list)) 9237 (setq start (match-end 0))) 9238 (or (eq start (length string)) 9239 (push (substring string start) list)) 9240 (nreverse list))) 9241 9242 (defun markdown--string-width (s) 9243 "Return width of string S. 9244 This version ignores characters with invisibility property 9245 `markdown-markup'." 9246 (let (b) 9247 (when (or (eq t buffer-invisibility-spec) 9248 (member 'markdown-markup buffer-invisibility-spec)) 9249 (while (setq b (text-property-any 9250 0 (length s) 9251 'invisible 'markdown-markup s)) 9252 (setq s (concat 9253 (substring s 0 b) 9254 (substring s (or (next-single-property-change 9255 b 'invisible s) 9256 (length s)))))))) 9257 (string-width s)) 9258 9259 (defun markdown--remove-invisible-markup (s) 9260 "Remove Markdown markup from string S. 9261 This version removes characters with invisibility property 9262 `markdown-markup'." 9263 (let (b) 9264 (while (setq b (text-property-any 9265 0 (length s) 9266 'invisible 'markdown-markup s)) 9267 (setq s (concat 9268 (substring s 0 b) 9269 (substring s (or (next-single-property-change 9270 b 'invisible s) 9271 (length s))))))) 9272 s) 9273 9274 ;; Functions for maintaining tables 9275 9276 (defvar markdown-table-at-point-p-function #'markdown--table-at-point-p 9277 "Function to decide if point is inside a table. 9278 9279 The indirection serves to differentiate between standard markdown 9280 tables and gfm tables which are less strict about the markup.") 9281 9282 (defconst markdown-table-line-regexp "^[ \t]*|" 9283 "Regexp matching any line inside a table.") 9284 9285 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]" 9286 "Regexp matching hline inside a table.") 9287 9288 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" 9289 "Regexp matching dline inside a table.") 9290 9291 (defun markdown-table-at-point-p () 9292 "Return non-nil when point is inside a table." 9293 (funcall markdown-table-at-point-p-function)) 9294 9295 (defun markdown--table-at-point-p () 9296 "Return non-nil when point is inside a table." 9297 (save-excursion 9298 (beginning-of-line) 9299 (and (looking-at-p markdown-table-line-regexp) 9300 (not (markdown-code-block-at-point-p))))) 9301 9302 (defconst gfm-table-line-regexp "^.?*|" 9303 "Regexp matching any line inside a table.") 9304 9305 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+" 9306 "Regexp matching hline inside a table.") 9307 9308 ;; GFM simplified tables syntax is as follows: 9309 ;; - A header line for the column names, this is any text 9310 ;; separated by `|'. 9311 ;; - Followed by a string -|-|- ..., the number of dashes is optional 9312 ;; but must be higher than 1. The number of separators should match 9313 ;; the number of columns. 9314 ;; - Followed by the rows of data, which has the same format as the 9315 ;; header line. 9316 ;; Example: 9317 ;; 9318 ;; foo | bar 9319 ;; ------|--------- 9320 ;; bar | baz 9321 ;; bar | baz 9322 (defun gfm--table-at-point-p () 9323 "Return non-nil when point is inside a gfm-compatible table." 9324 (or (markdown--table-at-point-p) 9325 (save-excursion 9326 (beginning-of-line) 9327 (when (looking-at-p gfm-table-line-regexp) 9328 ;; we might be at the first line of the table, check if the 9329 ;; line below is the hline 9330 (or (save-excursion 9331 (forward-line 1) 9332 (looking-at-p gfm-table-hline-regexp)) 9333 ;; go up to find the header 9334 (catch 'done 9335 (while (looking-at-p gfm-table-line-regexp) 9336 (cond 9337 ((looking-at-p gfm-table-hline-regexp) 9338 (throw 'done t)) 9339 ((bobp) 9340 (throw 'done nil))) 9341 (forward-line -1)) 9342 nil)))))) 9343 9344 (defun markdown-table-hline-at-point-p () 9345 "Return non-nil when point is on a hline in a table. 9346 This function assumes point is on a table." 9347 (save-excursion 9348 (beginning-of-line) 9349 (looking-at-p markdown-table-hline-regexp))) 9350 9351 (defun markdown-table-begin () 9352 "Find the beginning of the table and return its position. 9353 This function assumes point is on a table." 9354 (save-excursion 9355 (while (and (not (bobp)) 9356 (markdown-table-at-point-p)) 9357 (forward-line -1)) 9358 (unless (or (eobp) 9359 (markdown-table-at-point-p)) 9360 (forward-line 1)) 9361 (point))) 9362 9363 (defun markdown-table-end () 9364 "Find the end of the table and return its position. 9365 This function assumes point is on a table." 9366 (save-excursion 9367 (while (and (not (eobp)) 9368 (markdown-table-at-point-p)) 9369 (forward-line 1)) 9370 (point))) 9371 9372 (defun markdown-table-get-dline () 9373 "Return index of the table data line at point. 9374 This function assumes point is on a table." 9375 (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) 9376 (save-excursion 9377 (goto-char (markdown-table-begin)) 9378 (while (and (re-search-forward 9379 markdown-table-dline-regexp end t) 9380 (setq cnt (1+ cnt)) 9381 (< (line-end-position) pos)))) 9382 cnt)) 9383 9384 (defun markdown--thing-at-wiki-link (pos) 9385 (when markdown-enable-wiki-links 9386 (save-excursion 9387 (save-match-data 9388 (goto-char pos) 9389 (thing-at-point-looking-at markdown-regex-wiki-link))))) 9390 9391 (defun markdown-table-get-column () 9392 "Return table column at point. 9393 This function assumes point is on a table." 9394 (let ((pos (point)) (cnt 0)) 9395 (save-excursion 9396 (beginning-of-line) 9397 (while (search-forward "|" pos t) 9398 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9399 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9400 (setq cnt (1+ cnt))))) 9401 cnt)) 9402 9403 (defun markdown-table-get-cell (&optional n) 9404 "Return the content of the cell in column N of current row. 9405 N defaults to column at point. This function assumes point is on 9406 a table." 9407 (and n (markdown-table-goto-column n)) 9408 (skip-chars-backward "^|\n") (backward-char 1) 9409 (if (looking-at "|[^|\r\n]*") 9410 (let* ((pos (match-beginning 0)) 9411 (val (buffer-substring (1+ pos) (match-end 0)))) 9412 (goto-char (min (line-end-position) (+ 2 pos))) 9413 ;; Trim whitespaces 9414 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) 9415 val (replace-regexp-in-string "[ \t]+\\'" "" val))) 9416 (forward-char 1) "")) 9417 9418 (defun markdown-table-goto-dline (n) 9419 "Go to the Nth data line in the table at point. 9420 Return t when the line exists, nil otherwise. This function 9421 assumes point is on a table." 9422 (goto-char (markdown-table-begin)) 9423 (let ((end (markdown-table-end)) (cnt 0)) 9424 (while (and (re-search-forward 9425 markdown-table-dline-regexp end t) 9426 (< (setq cnt (1+ cnt)) n))) 9427 (= cnt n))) 9428 9429 (defun markdown-table-goto-column (n &optional on-delim) 9430 "Go to the Nth column in the table line at point. 9431 With optional argument ON-DELIM, stop with point before the left 9432 delimiter of the cell. If there are less than N cells, just go 9433 beyond the last delimiter. This function assumes point is on a 9434 table." 9435 (beginning-of-line 1) 9436 (when (> n 0) 9437 (while (and (> n 0) (search-forward "|" (line-end-position) t)) 9438 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9439 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9440 (cl-decf n))) 9441 (if on-delim 9442 (backward-char 1) 9443 (when (looking-at " ") (forward-char 1))))) 9444 9445 (defmacro markdown-table-save-cell (&rest body) 9446 "Save cell at point, execute BODY and restore cell. 9447 This function assumes point is on a table." 9448 (declare (debug (body))) 9449 (markdown--with-gensyms (line column) 9450 `(let ((,line (copy-marker (line-beginning-position))) 9451 (,column (markdown-table-get-column))) 9452 (unwind-protect 9453 (progn ,@body) 9454 (goto-char ,line) 9455 (markdown-table-goto-column ,column) 9456 (set-marker ,line nil))))) 9457 9458 (defun markdown-table-blank-line (s) 9459 "Convert a table line S into a line with blank cells." 9460 (if (string-match "^[ \t]*|-" s) 9461 (setq s (mapconcat 9462 (lambda (x) (if (member x '(?| ?+)) "|" " ")) 9463 s "")) 9464 (with-temp-buffer 9465 (insert s) 9466 (goto-char (point-min)) 9467 (when (re-search-forward "|" nil t) 9468 (let ((cur (point)) 9469 ret) 9470 (while (re-search-forward "|" nil t) 9471 (when (and (not (eql (char-before (match-beginning 0)) ?\\)) 9472 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9473 (push (make-string (- (match-beginning 0) cur) ? ) ret) 9474 (setq cur (match-end 0)))) 9475 (format "|%s|" (string-join (nreverse ret) "|"))))))) 9476 9477 (defun markdown-table-colfmt (fmtspec) 9478 "Process column alignment specifier FMTSPEC for tables." 9479 (when (stringp fmtspec) 9480 (mapcar (lambda (x) 9481 (cond ((string-match-p "^:.*:$" x) 'c) 9482 ((string-match-p "^:" x) 'l) 9483 ((string-match-p ":$" x) 'r) 9484 (t 'd))) 9485 (markdown--split-string fmtspec "\\s-*|\\s-*")))) 9486 9487 (defun markdown--first-column-p (bar-pos) 9488 (save-excursion 9489 (save-match-data 9490 (goto-char bar-pos) 9491 (looking-back "^\\s-*" (line-beginning-position))))) 9492 9493 (defun markdown--table-line-to-columns (line) 9494 (with-temp-buffer 9495 (insert line) 9496 (goto-char (point-min)) 9497 (let ((cur (point)) 9498 ret) 9499 (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) 9500 (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) 9501 (if (markdown--first-column-p (match-beginning 1)) 9502 (setq cur (match-end 0)) 9503 (cond ((eql (char-before (match-beginning 1)) ?\\) 9504 ;; keep spaces 9505 (goto-char (match-end 1))) 9506 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing 9507 (t 9508 (push (buffer-substring-no-properties cur (match-beginning 0)) ret) 9509 (setq cur (match-end 0))))))) 9510 (when (< cur (length line)) 9511 (push (buffer-substring-no-properties cur (point-max)) ret)) 9512 (nreverse ret)))) 9513 9514 (defsubst markdown--is-delimiter-row (line) 9515 (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) 9516 (cl-loop for c across line 9517 always (member c '(?| ?- ?: ?\t ? ))))) 9518 9519 (defun markdown-table-align () 9520 "Align table at point. 9521 This function assumes point is on a table." 9522 (interactive) 9523 (let ((begin (markdown-table-begin)) 9524 (end (copy-marker (markdown-table-end)))) 9525 (markdown-table-save-cell 9526 (goto-char begin) 9527 (let* (fmtspec 9528 ;; Store table indent 9529 (indent (progn (looking-at "[ \t]*") (match-string 0))) 9530 ;; Split table in lines and save column format specifier 9531 (lines (mapcar (lambda (line) 9532 (if (markdown--is-delimiter-row line) 9533 (progn (setq fmtspec (or fmtspec line)) nil) 9534 line)) 9535 (markdown--split-string (buffer-substring begin end) "\n"))) 9536 ;; Split lines in cells 9537 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) 9538 (remq nil lines))) 9539 ;; Calculate maximum number of cells in a line 9540 (maxcells (if cells 9541 (apply #'max (mapcar #'length cells)) 9542 (user-error "Empty table"))) 9543 ;; Empty cells to fill short lines 9544 (emptycells (make-list maxcells "")) 9545 maxwidths) 9546 ;; Calculate maximum width for each column 9547 (dotimes (i maxcells) 9548 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) 9549 (push (apply #'max 1 (mapcar #'markdown--string-width column)) 9550 maxwidths))) 9551 (setq maxwidths (nreverse maxwidths)) 9552 ;; Process column format specifier 9553 (setq fmtspec (markdown-table-colfmt fmtspec)) 9554 ;; Compute formats needed for output of table lines 9555 (let ((hfmt (concat indent "|")) 9556 (rfmt (concat indent "|")) 9557 hfmt1 rfmt1 fmt) 9558 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) 9559 (setq fmt (pop fmtspec)) 9560 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) 9561 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) 9562 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) 9563 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) 9564 (setq rfmt (concat rfmt (format rfmt1 width))) 9565 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) 9566 ;; Replace modified lines only 9567 (dolist (line lines) 9568 (let ((line (if line 9569 (apply #'format rfmt (append (pop cells) emptycells)) 9570 hfmt)) 9571 (previous (buffer-substring (point) (line-end-position)))) 9572 (if (equal previous line) 9573 (forward-line) 9574 (insert line "\n") 9575 (delete-region (point) (line-beginning-position 2)))))) 9576 (set-marker end nil))))) 9577 9578 (defun markdown-table-insert-row (&optional arg) 9579 "Insert a new row above the row at point into the table. 9580 With optional argument ARG, insert below the current row." 9581 (interactive "P") 9582 (unless (markdown-table-at-point-p) 9583 (user-error "Not at a table")) 9584 (let* ((line (buffer-substring 9585 (line-beginning-position) (line-end-position))) 9586 (new (markdown-table-blank-line line))) 9587 (beginning-of-line (if arg 2 1)) 9588 (unless (bolp) (insert "\n")) 9589 (insert-before-markers new "\n") 9590 (beginning-of-line 0) 9591 (re-search-forward "| ?" (line-end-position) t))) 9592 9593 (defun markdown-table-delete-row () 9594 "Delete row or horizontal line at point from the table." 9595 (interactive) 9596 (unless (markdown-table-at-point-p) 9597 (user-error "Not at a table")) 9598 (let ((col (current-column))) 9599 (kill-region (line-beginning-position) 9600 (min (1+ (line-end-position)) (point-max))) 9601 (unless (markdown-table-at-point-p) (beginning-of-line 0)) 9602 (move-to-column col))) 9603 9604 (defun markdown-table-move-row (&optional up) 9605 "Move table line at point down. 9606 With optional argument UP, move it up." 9607 (interactive "P") 9608 (unless (markdown-table-at-point-p) 9609 (user-error "Not at a table")) 9610 (let* ((col (current-column)) (pos (point)) 9611 (tonew (if up 0 2)) txt) 9612 (beginning-of-line tonew) 9613 (unless (markdown-table-at-point-p) 9614 (goto-char pos) (user-error "Cannot move row further")) 9615 (goto-char pos) (beginning-of-line 1) (setq pos (point)) 9616 (setq txt (buffer-substring (point) (1+ (line-end-position)))) 9617 (delete-region (point) (1+ (line-end-position))) 9618 (beginning-of-line tonew) 9619 (insert txt) (beginning-of-line 0) 9620 (move-to-column col))) 9621 9622 (defun markdown-table-move-row-up () 9623 "Move table row at point up." 9624 (interactive) 9625 (markdown-table-move-row 'up)) 9626 9627 (defun markdown-table-move-row-down () 9628 "Move table row at point down." 9629 (interactive) 9630 (markdown-table-move-row nil)) 9631 9632 (defun markdown-table-insert-column () 9633 "Insert a new table column." 9634 (interactive) 9635 (unless (markdown-table-at-point-p) 9636 (user-error "Not at a table")) 9637 (let* ((col (max 1 (markdown-table-get-column))) 9638 (begin (markdown-table-begin)) 9639 (end (copy-marker (markdown-table-end)))) 9640 (markdown-table-save-cell 9641 (goto-char begin) 9642 (while (< (point) end) 9643 (markdown-table-goto-column col t) 9644 (if (markdown-table-hline-at-point-p) 9645 (insert "|---") 9646 (insert "| ")) 9647 (forward-line))) 9648 (set-marker end nil) 9649 (when markdown-table-align-p 9650 (markdown-table-align)))) 9651 9652 (defun markdown-table-delete-column () 9653 "Delete column at point from table." 9654 (interactive) 9655 (unless (markdown-table-at-point-p) 9656 (user-error "Not at a table")) 9657 (let ((col (markdown-table-get-column)) 9658 (begin (markdown-table-begin)) 9659 (end (copy-marker (markdown-table-end)))) 9660 (markdown-table-save-cell 9661 (goto-char begin) 9662 (while (< (point) end) 9663 (markdown-table-goto-column col t) 9664 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") 9665 (replace-match "|")) 9666 (forward-line))) 9667 (set-marker end nil) 9668 (markdown-table-goto-column (max 1 (1- col))) 9669 (when markdown-table-align-p 9670 (markdown-table-align)))) 9671 9672 (defun markdown-table-move-column (&optional left) 9673 "Move table column at point to the right. 9674 With optional argument LEFT, move it to the left." 9675 (interactive "P") 9676 (unless (markdown-table-at-point-p) 9677 (user-error "Not at a table")) 9678 (let* ((col (markdown-table-get-column)) 9679 (col1 (if left (1- col) col)) 9680 (colpos (if left (1- col) (1+ col))) 9681 (begin (markdown-table-begin)) 9682 (end (copy-marker (markdown-table-end)))) 9683 (when (and left (= col 1)) 9684 (user-error "Cannot move column further left")) 9685 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) 9686 (user-error "Cannot move column further right")) 9687 (markdown-table-save-cell 9688 (goto-char begin) 9689 (while (< (point) end) 9690 (markdown-table-goto-column col1 t) 9691 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") 9692 (replace-match "|\\2|\\1|")) 9693 (forward-line))) 9694 (set-marker end nil) 9695 (markdown-table-goto-column colpos) 9696 (when markdown-table-align-p 9697 (markdown-table-align)))) 9698 9699 (defun markdown-table-move-column-left () 9700 "Move table column at point to the left." 9701 (interactive) 9702 (markdown-table-move-column 'left)) 9703 9704 (defun markdown-table-move-column-right () 9705 "Move table column at point to the right." 9706 (interactive) 9707 (markdown-table-move-column nil)) 9708 9709 (defun markdown-table-next-row () 9710 "Go to the next row (same column) in the table. 9711 Create new table lines if required." 9712 (interactive) 9713 (unless (markdown-table-at-point-p) 9714 (user-error "Not at a table")) 9715 (if (or (looking-at "[ \t]*$") 9716 (save-excursion (skip-chars-backward " \t") (bolp))) 9717 (newline) 9718 (when markdown-table-align-p 9719 (markdown-table-align)) 9720 (let ((col (markdown-table-get-column))) 9721 (beginning-of-line 2) 9722 (if (or (not (markdown-table-at-point-p)) 9723 (markdown-table-hline-at-point-p)) 9724 (progn 9725 (beginning-of-line 0) 9726 (markdown-table-insert-row 'below))) 9727 (markdown-table-goto-column col) 9728 (skip-chars-backward "^|\n\r") 9729 (when (looking-at " ") (forward-char 1))))) 9730 9731 (defun markdown-table-forward-cell () 9732 "Go to the next cell in the table. 9733 Create new table lines if required." 9734 (interactive) 9735 (unless (markdown-table-at-point-p) 9736 (user-error "Not at a table")) 9737 (when markdown-table-align-p 9738 (markdown-table-align)) 9739 (let ((end (markdown-table-end))) 9740 (when (markdown-table-hline-at-point-p) (end-of-line 1)) 9741 (condition-case nil 9742 (progn 9743 (re-search-forward "\\(?:^\\|[^\\]\\)|" end) 9744 (when (looking-at "[ \t]*$") 9745 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) 9746 (when (and (looking-at "[-:]") 9747 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) 9748 (goto-char (match-beginning 1))) 9749 (if (looking-at "[-:]") 9750 (progn 9751 (beginning-of-line 0) 9752 (markdown-table-insert-row 'below)) 9753 (when (looking-at " ") (forward-char 1)))) 9754 (error (markdown-table-insert-row 'below))))) 9755 9756 (defun markdown-table-backward-cell () 9757 "Go to the previous cell in the table." 9758 (interactive) 9759 (unless (markdown-table-at-point-p) 9760 (user-error "Not at a table")) 9761 (when markdown-table-align-p 9762 (markdown-table-align)) 9763 (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) 9764 (condition-case nil 9765 (progn 9766 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) 9767 ;; When this function is called while in the first cell in a 9768 ;; table, the point will now be at the beginning of a line. In 9769 ;; this case, we need to move past one additional table 9770 ;; boundary, the end of the table on the previous line. 9771 (when (= (point) (line-beginning-position)) 9772 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9773 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9774 (error (user-error "Cannot move to previous table cell"))) 9775 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) 9776 9777 ;; This may have dropped point on the hline. 9778 (when (markdown-table-hline-at-point-p) 9779 (markdown-table-backward-cell))) 9780 9781 (defun markdown-table-transpose () 9782 "Transpose table at point. 9783 Horizontal separator lines will be eliminated." 9784 (interactive) 9785 (unless (markdown-table-at-point-p) 9786 (user-error "Not at a table")) 9787 (let* ((table (buffer-substring-no-properties 9788 (markdown-table-begin) (markdown-table-end))) 9789 ;; Convert table to Lisp structure 9790 (table (delq nil 9791 (mapcar 9792 (lambda (x) 9793 (unless (string-match-p 9794 markdown-table-hline-regexp x) 9795 (markdown--table-line-to-columns x))) 9796 (markdown--split-string table "[ \t]*\n[ \t]*")))) 9797 (dline_old (markdown-table-get-dline)) 9798 (col_old (markdown-table-get-column)) 9799 (contents (mapcar (lambda (_) 9800 (let ((tp table)) 9801 (mapcar 9802 (lambda (_) 9803 (prog1 9804 (pop (car tp)) 9805 (setq tp (cdr tp)))) 9806 table))) 9807 (car table)))) 9808 (goto-char (markdown-table-begin)) 9809 (save-excursion 9810 (re-search-forward "|") (backward-char) 9811 (delete-region (point) (markdown-table-end)) 9812 (insert (mapconcat 9813 (lambda(x) 9814 (concat "| " (mapconcat 'identity x " | " ) " |\n")) 9815 contents ""))) 9816 (markdown-table-goto-dline col_old) 9817 (markdown-table-goto-column dline_old)) 9818 (when markdown-table-align-p 9819 (markdown-table-align))) 9820 9821 (defun markdown-table-sort-lines (&optional sorting-type) 9822 "Sort table lines according to the column at point. 9823 9824 The position of point indicates the column to be used for 9825 sorting, and the range of lines is the range between the nearest 9826 horizontal separator lines, or the entire table of no such lines 9827 exist. If point is before the first column, user will be prompted 9828 for the sorting column. If there is an active region, the mark 9829 specifies the first line and the sorting column, while point 9830 should be in the last line to be included into the sorting. 9831 9832 The command then prompts for the sorting type which can be 9833 alphabetically or numerically. Sorting in reverse order is also 9834 possible. 9835 9836 If SORTING-TYPE is specified when this function is called from a 9837 Lisp program, no prompting will take place. SORTING-TYPE must be 9838 a character, any of (?a ?A ?n ?N) where the capital letters 9839 indicate that sorting should be done in reverse order." 9840 (interactive) 9841 (unless (markdown-table-at-point-p) 9842 (user-error "Not at a table")) 9843 ;; Set sorting type and column used for sorting 9844 (let ((column (let ((c (markdown-table-get-column))) 9845 (cond ((> c 0) c) 9846 ((called-interactively-p 'any) 9847 (read-number "Use column N for sorting: ")) 9848 (t 1)))) 9849 (sorting-type 9850 (or sorting-type 9851 (progn 9852 ;; workaround #641 9853 ;; Emacs < 28 hides prompt message by another message. This erases it. 9854 (message "") 9855 (read-char-exclusive 9856 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) 9857 (save-restriction 9858 ;; Narrow buffer to appropriate sorting area 9859 (if (region-active-p) 9860 (narrow-to-region 9861 (save-excursion 9862 (progn 9863 (goto-char (region-beginning)) (line-beginning-position))) 9864 (save-excursion 9865 (progn 9866 (goto-char (region-end)) (line-end-position)))) 9867 (let ((start (markdown-table-begin)) 9868 (end (markdown-table-end))) 9869 (narrow-to-region 9870 (save-excursion 9871 (if (re-search-backward 9872 markdown-table-hline-regexp start t) 9873 (line-beginning-position 2) 9874 start)) 9875 (if (save-excursion (re-search-forward 9876 markdown-table-hline-regexp end t)) 9877 (match-beginning 0) 9878 end)))) 9879 ;; Determine arguments for `sort-subr' 9880 (let* ((extract-key-from-cell 9881 (cl-case sorting-type 9882 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) 9883 ((?n ?N) #'string-to-number) 9884 (t (user-error "Invalid sorting type: %c" sorting-type)))) 9885 (predicate 9886 (cl-case sorting-type 9887 ((?n ?N) #'<) 9888 ((?a ?A) #'string<)))) 9889 ;; Sort selected area 9890 (goto-char (point-min)) 9891 (sort-subr (memq sorting-type '(?A ?N)) 9892 (lambda () 9893 (forward-line) 9894 (while (and (not (eobp)) 9895 (not (looking-at 9896 markdown-table-dline-regexp))) 9897 (forward-line))) 9898 #'end-of-line 9899 (lambda () 9900 (funcall extract-key-from-cell 9901 (markdown-table-get-cell column))) 9902 nil 9903 predicate) 9904 (goto-char (point-min)))))) 9905 9906 (defun markdown-table-convert-region (begin end &optional separator) 9907 "Convert region from BEGIN to END to table with SEPARATOR. 9908 9909 If every line contains at least one TAB character, the function 9910 assumes that the material is tab separated (TSV). If every line 9911 contains a comma, comma-separated values (CSV) are assumed. If 9912 not, lines are split at whitespace into cells. 9913 9914 You can use a prefix argument to force a specific separator: 9915 \\[universal-argument] once forces CSV, \\[universal-argument] 9916 twice forces TAB, and \\[universal-argument] three times will 9917 prompt for a regular expression to match the separator, and a 9918 numeric argument N indicates that at least N consecutive 9919 spaces, or alternatively a TAB should be used as the separator." 9920 9921 (interactive "r\nP") 9922 (let* ((begin (min begin end)) (end (max begin end)) re) 9923 (goto-char begin) (beginning-of-line 1) 9924 (setq begin (point-marker)) 9925 (goto-char end) 9926 (if (bolp) (backward-char 1) (end-of-line 1)) 9927 (setq end (point-marker)) 9928 (when (equal separator '(64)) 9929 (setq separator (read-regexp "Regexp for cell separator: "))) 9930 (unless separator 9931 ;; Get the right cell separator 9932 (goto-char begin) 9933 (setq separator 9934 (cond 9935 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) 9936 ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) 9937 (t 1)))) 9938 (goto-char begin) 9939 (if (equal separator '(4)) 9940 ;; Parse CSV 9941 (while (< (point) end) 9942 (cond 9943 ((looking-at "^") (insert "| ")) 9944 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) 9945 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") 9946 (replace-match "\\1") (if (looking-at "\"") (insert "\""))) 9947 ((looking-at "[^,\n]+") (goto-char (match-end 0))) 9948 ((looking-at "[ \t]*,") (replace-match " | ")) 9949 (t (beginning-of-line 2)))) 9950 (setq re 9951 (cond 9952 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") 9953 ((equal separator '(16)) "^\\|\t") 9954 ((integerp separator) 9955 (if (< separator 1) 9956 (user-error "Cell separator must contain one or more spaces") 9957 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) 9958 ((stringp separator) (format "^ *\\|%s" separator)) 9959 (t (error "Invalid cell separator")))) 9960 (let (finish) 9961 (while (and (not finish) (re-search-forward re end t)) 9962 (if (eolp) 9963 (progn 9964 (replace-match "|" t t) 9965 (forward-line 1) 9966 (when (eobp) 9967 (setq finish t))) 9968 (replace-match "| " t t))))) 9969 (goto-char begin) 9970 (when markdown-table-align-p 9971 (markdown-table-align)))) 9972 9973 (defun markdown-insert-table (&optional rows columns align) 9974 "Insert an empty pipe table. 9975 Optional arguments ROWS, COLUMNS, and ALIGN specify number of 9976 rows and columns and the column alignment." 9977 (interactive) 9978 (let* ((rows (or rows (read-number "Number of Rows: "))) 9979 (columns (or columns (read-number "Number of Columns: "))) 9980 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) 9981 (align (cond ((equal align "l") ":--") 9982 ((equal align "r") "--:") 9983 ((equal align "c") ":-:") 9984 (t "---"))) 9985 (pos (point)) 9986 (indent (make-string (current-column) ?\ )) 9987 (line (concat 9988 (apply 'concat indent "|" 9989 (make-list columns " |")) "\n")) 9990 (hline (apply 'concat indent "|" 9991 (make-list columns (concat align "|"))))) 9992 (if (string-match 9993 "^[ \t]*$" (buffer-substring-no-properties 9994 (line-beginning-position) (point))) 9995 (beginning-of-line 1) 9996 (newline)) 9997 (dotimes (_ rows) (insert line)) 9998 (goto-char pos) 9999 (if (> rows 1) 10000 (progn 10001 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) 10002 (markdown-table-forward-cell))) 10003 10004 10005 ;;; ElDoc Support ============================================================= 10006 10007 (defun markdown-eldoc-function (&rest _ignored) 10008 "Return a helpful string when appropriate based on context. 10009 * Report URL when point is at a hidden URL. 10010 * Report language name when point is a code block with hidden markup." 10011 (cond 10012 ;; Hidden URL or reference for inline link 10013 ((and (or (thing-at-point-looking-at markdown-regex-link-inline) 10014 (thing-at-point-looking-at markdown-regex-link-reference)) 10015 (or markdown-hide-urls markdown-hide-markup)) 10016 (let* ((imagep (string-equal (match-string 1) "!")) 10017 (referencep (string-equal (match-string 5) "[")) 10018 (link (match-string-no-properties 6)) 10019 (edit-keys (markdown--substitute-command-keys 10020 (if imagep 10021 "\\[markdown-insert-image]" 10022 "\\[markdown-insert-link]"))) 10023 (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) 10024 (object (if referencep "reference" "URL"))) 10025 (format "Hidden %s (%s to edit): %s" object edit-str 10026 (if referencep 10027 (concat 10028 (propertize "[" 'face 'markdown-markup-face) 10029 (propertize link 'face 'markdown-reference-face) 10030 (propertize "]" 'face 'markdown-markup-face)) 10031 (propertize link 'face 'markdown-url-face))))) 10032 ;; Hidden language name for fenced code blocks 10033 ((and (markdown-code-block-at-point-p) 10034 (not (get-text-property (point) 'markdown-pre)) 10035 markdown-hide-markup) 10036 (let ((lang (save-excursion (markdown-code-block-lang)))) 10037 (unless lang (setq lang "[unspecified]")) 10038 (format "Hidden code block language: %s (%s to toggle markup)" 10039 (propertize lang 'face 'markdown-language-keyword-face) 10040 (markdown--substitute-command-keys 10041 "\\[markdown-toggle-markup-hiding]")))))) 10042 10043 (defun markdown--image-media-handler (mimetype data) 10044 (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) 10045 (filename (read-string "Insert filename for image: ")) 10046 (link-text (read-string "Link text: ")) 10047 (filepath (file-name-with-extension filename ext)) 10048 (dir (file-name-directory filepath))) 10049 (when (and dir (not (file-directory-p dir))) 10050 (make-directory dir t)) 10051 (with-temp-file filepath 10052 (insert data)) 10053 (when (string-match-p "\\s-" filepath) 10054 (setq filepath (concat "<" filepath ">"))) 10055 (markdown-insert-inline-image link-text filepath))) 10056 10057 (defun markdown--file-media-handler (_mimetype data) 10058 (let* ((data (split-string data "[\0\r\n]" t "^file://")) 10059 (files (cdr data))) 10060 (while (not (null files)) 10061 (let* ((file (url-unhex-string (car files))) 10062 (file (file-relative-name file)) 10063 (prompt (format "Link text(%s): " (file-name-nondirectory file))) 10064 (link-text (read-string prompt))) 10065 (when (string-match-p "\\s-" file) 10066 (setq file (concat "<" file ">"))) 10067 (markdown-insert-inline-image link-text file) 10068 (when (not (null (cdr files))) 10069 (insert " ")) 10070 (setq files (cdr files)))))) 10071 10072 (defun markdown--dnd-local-file-handler (url _action) 10073 (require 'mailcap) 10074 (require 'dnd) 10075 (let* ((filename (dnd-get-local-file-name url)) 10076 (mimetype (mailcap-file-name-to-mime-type filename)) 10077 (file (file-relative-name filename)) 10078 (link-text "link text")) 10079 (when (string-match-p "\\s-" file) 10080 (setq file (concat "<" file ">"))) 10081 (if (string-prefix-p "image/" mimetype) 10082 (markdown-insert-inline-image link-text file) 10083 (markdown-insert-inline-link link-text file)))) 10084 10085 10086 ;;; Mode Definition ========================================================== 10087 10088 (defun markdown-show-version () 10089 "Show the version number in the minibuffer." 10090 (interactive) 10091 (message "markdown-mode, version %s" markdown-mode-version)) 10092 10093 (defun markdown-mode-info () 10094 "Open the `markdown-mode' homepage." 10095 (interactive) 10096 (browse-url "https://jblevins.org/projects/markdown-mode/")) 10097 10098 ;;;###autoload 10099 (define-derived-mode markdown-mode text-mode "Markdown" 10100 "Major mode for editing Markdown files." 10101 (when buffer-read-only 10102 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) 10103 (setq-local buffer-read-only nil))) 10104 ;; Natural Markdown tab width 10105 (setq tab-width 4) 10106 ;; Comments 10107 (setq-local comment-start "<!-- ") 10108 (setq-local comment-end " -->") 10109 (setq-local comment-start-skip "<!--[ \t]*") 10110 (setq-local comment-column 0) 10111 (setq-local comment-auto-fill-only-comments nil) 10112 (setq-local comment-use-syntax t) 10113 ;; Sentence 10114 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") 10115 ;; Syntax 10116 (add-hook 'syntax-propertize-extend-region-functions 10117 #'markdown-syntax-propertize-extend-region nil t) 10118 (add-hook 'jit-lock-after-change-extend-region-functions 10119 #'markdown-font-lock-extend-region-function t t) 10120 (setq-local syntax-propertize-function #'markdown-syntax-propertize) 10121 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. 10122 ;; Font lock. 10123 (setq font-lock-defaults 10124 '(markdown-mode-font-lock-keywords 10125 nil nil nil nil 10126 (font-lock-multiline . t) 10127 (font-lock-syntactic-face-function . markdown-syntactic-face) 10128 (font-lock-extra-managed-props 10129 . (composition display invisible rear-nonsticky 10130 keymap help-echo mouse-face)))) 10131 (if markdown-hide-markup 10132 (add-to-invisibility-spec 'markdown-markup) 10133 (remove-from-invisibility-spec 'markdown-markup)) 10134 ;; Wiki links 10135 (markdown-setup-wiki-link-hooks) 10136 ;; Math mode 10137 (when markdown-enable-math (markdown-toggle-math t)) 10138 ;; Add a buffer-local hook to reload after file-local variables are read 10139 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) 10140 ;; For imenu support 10141 (setq imenu-create-index-function 10142 (if markdown-nested-imenu-heading-index 10143 #'markdown-imenu-create-nested-index 10144 #'markdown-imenu-create-flat-index)) 10145 10146 ;; Defun movement 10147 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) 10148 (setq-local end-of-defun-function #'markdown-end-of-defun) 10149 ;; Paragraph filling 10150 (setq-local fill-paragraph-function #'markdown-fill-paragraph) 10151 (setq-local paragraph-start 10152 ;; Should match start of lines that start or separate paragraphs 10153 (mapconcat #'identity 10154 '( 10155 "\f" ; starts with a literal line-feed 10156 "[ \t\f]*$" ; space-only line 10157 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10158 "[ \t]*[*+-][ \t]+" ; unordered list item 10159 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item 10160 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def 10161 "[ \t]*:[ \t]+" ; definition 10162 "^|" ; table or Pandoc line block 10163 ) 10164 "\\|")) 10165 (setq-local paragraph-separate 10166 ;; Should match lines that separate paragraphs without being 10167 ;; part of any paragraph: 10168 (mapconcat #'identity 10169 '("[ \t\f]*$" ; space-only line 10170 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10171 ;; The following is not ideal, but the Fill customization 10172 ;; options really only handle paragraph-starting prefixes, 10173 ;; not paragraph-ending suffixes: 10174 ".* $" ; line ending in two spaces 10175 "^#+" 10176 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext 10177 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def 10178 "\\|")) 10179 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") 10180 (setq-local adaptive-fill-regexp "\\s-*") 10181 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) 10182 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) 10183 ;; Outline mode 10184 (setq-local outline-regexp markdown-regex-header) 10185 (setq-local outline-level #'markdown-outline-level) 10186 ;; Cause use of ellipses for invisible text. 10187 (add-to-invisibility-spec '(outline . t)) 10188 ;; ElDoc support 10189 (if (boundp 'eldoc-documentation-functions) 10190 (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) 10191 (add-function :before-until (local 'eldoc-documentation-function) 10192 #'markdown-eldoc-function)) 10193 ;; Inhibiting line-breaking: 10194 ;; Separating out each condition into a separate function so that users can 10195 ;; override if desired (with remove-hook) 10196 (add-hook 'fill-nobreak-predicate 10197 #'markdown-line-is-reference-definition-p nil t) 10198 (add-hook 'fill-nobreak-predicate 10199 #'markdown-pipe-at-bol-p nil t) 10200 10201 ;; Indentation 10202 (setq-local indent-line-function markdown-indent-function) 10203 (setq-local indent-region-function #'markdown--indent-region) 10204 10205 ;; Flyspell 10206 (setq-local flyspell-generic-check-word-predicate 10207 #'markdown-flyspell-check-word-p) 10208 10209 ;; Electric quoting 10210 (add-hook 'electric-quote-inhibit-functions 10211 #'markdown--inhibit-electric-quote nil :local) 10212 10213 ;; drag and drop handler 10214 (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) 10215 dnd-protocol-alist)) 10216 10217 ;; media handler 10218 (when (version< "29" emacs-version) 10219 (yank-media-handler "image/.*" #'markdown--image-media-handler) 10220 ;; TODO support other than GNOME, like KDE etc 10221 (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) 10222 10223 ;; Make checkboxes buttons 10224 (when markdown-make-gfm-checkboxes-buttons 10225 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) 10226 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) 10227 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) 10228 10229 ;; edit-indirect 10230 (add-hook 'edit-indirect-after-commit-functions 10231 #'markdown--edit-indirect-after-commit-function 10232 nil 'local) 10233 10234 ;; Marginalized headings 10235 (when markdown-marginalize-headers 10236 (add-hook 'window-configuration-change-hook 10237 #'markdown-marginalize-update-current nil t)) 10238 10239 ;; add live preview export hook 10240 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) 10241 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) 10242 10243 ;; Add a custom keymap for `visual-line-mode' so that activating 10244 ;; this minor mode does not override markdown-mode's keybindings. 10245 ;; FIXME: Probably `visual-line-mode' should take care of this. 10246 (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) 10247 (newmap (make-sparse-keymap))) 10248 (set-keymap-parent newmap oldmap) 10249 (define-key newmap [remap move-beginning-of-line] nil) 10250 (define-key newmap [remap move-end-of-line] nil) 10251 (make-local-variable 'minor-mode-overriding-map-alist) 10252 (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) 10253 10254 ;;;###autoload 10255 (add-to-list 'auto-mode-alist 10256 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) 10257 10258 10259 ;;; GitHub Flavored Markdown Mode ============================================ 10260 10261 (defun gfm--electric-pair-fence-code-block () 10262 (when (and electric-pair-mode 10263 (not markdown-gfm-use-electric-backquote) 10264 (eql last-command-event ?`) 10265 (let ((count 0)) 10266 (while (eql (char-before (- (point) count)) ?`) 10267 (cl-incf count)) 10268 (= count 3)) 10269 (eql (char-after) ?`)) 10270 (save-excursion (insert (make-string 2 ?`))))) 10271 10272 (defvar gfm-mode-hook nil 10273 "Hook run when entering GFM mode.") 10274 10275 ;;;###autoload 10276 (define-derived-mode gfm-mode markdown-mode "GFM" 10277 "Major mode for editing GitHub Flavored Markdown files." 10278 (setq markdown-link-space-sub-char "-") 10279 (setq markdown-wiki-link-search-subdirectories t) 10280 (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) 10281 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) 10282 (markdown-gfm-parse-buffer-for-languages)) 10283 10284 10285 ;;; Viewing modes ============================================================= 10286 10287 (defcustom markdown-hide-markup-in-view-modes t 10288 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." 10289 :group 'markdown 10290 :type 'boolean 10291 :safe #'booleanp) 10292 10293 (defvar markdown-view-mode-map 10294 (let ((map (make-sparse-keymap))) 10295 (define-key map (kbd "p") #'markdown-outline-previous) 10296 (define-key map (kbd "n") #'markdown-outline-next) 10297 (define-key map (kbd "f") #'markdown-outline-next-same-level) 10298 (define-key map (kbd "b") #'markdown-outline-previous-same-level) 10299 (define-key map (kbd "u") #'markdown-outline-up) 10300 (define-key map (kbd "DEL") #'scroll-down-command) 10301 (define-key map (kbd "SPC") #'scroll-up-command) 10302 (define-key map (kbd ">") #'end-of-buffer) 10303 (define-key map (kbd "<") #'beginning-of-buffer) 10304 (define-key map (kbd "q") #'kill-this-buffer) 10305 (define-key map (kbd "?") #'describe-mode) 10306 map) 10307 "Keymap for `markdown-view-mode'.") 10308 10309 (defun markdown--filter-visible (beg end &optional delete) 10310 (let ((result "") 10311 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) 10312 (while (< beg end) 10313 (when (markdown--face-p beg invisible-faces) 10314 (cl-incf beg) 10315 (while (and (markdown--face-p beg invisible-faces) (< beg end)) 10316 (cl-incf beg))) 10317 (let ((next (next-single-char-property-change beg 'invisible))) 10318 (unless (get-char-property beg 'invisible) 10319 (setq result (concat result (buffer-substring beg (min end next))))) 10320 (setq beg next))) 10321 (prog1 result 10322 (when delete 10323 (let ((inhibit-read-only t)) 10324 (delete-region beg end)))))) 10325 10326 ;;;###autoload 10327 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View" 10328 "Major mode for viewing Markdown content." 10329 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10330 (add-to-invisibility-spec 'markdown-markup) 10331 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10332 (read-only-mode 1)) 10333 10334 (defvar gfm-view-mode-map 10335 markdown-view-mode-map 10336 "Keymap for `gfm-view-mode'.") 10337 10338 ;;;###autoload 10339 (define-derived-mode gfm-view-mode gfm-mode "GFM-View" 10340 "Major mode for viewing GitHub Flavored Markdown content." 10341 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10342 (setq-local markdown-fontify-code-blocks-natively t) 10343 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10344 (add-to-invisibility-spec 'markdown-markup) 10345 (read-only-mode 1)) 10346 10347 10348 ;;; Live Preview Mode ======================================================== 10349 ;;;###autoload 10350 (define-minor-mode markdown-live-preview-mode 10351 "Toggle native previewing on save for a specific markdown file." 10352 :lighter " MD-Preview" 10353 (if markdown-live-preview-mode 10354 (if (markdown-live-preview-get-filename) 10355 (markdown-display-buffer-other-window (markdown-live-preview-export)) 10356 (markdown-live-preview-mode -1) 10357 (user-error "Buffer %s does not visit a file" (current-buffer))) 10358 (markdown-live-preview-remove))) 10359 10360 10361 (provide 'markdown-mode) 10362 10363 ;; Local Variables: 10364 ;; indent-tabs-mode: nil 10365 ;; coding: utf-8 10366 ;; End: 10367 ;;; markdown-mode.el ends here