markdown-mode.el (419893B)
1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2007-2020 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.5 10 ;; Package-Requires: ((emacs "25.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 55 56 ;;; Constants ================================================================= 57 58 (defconst markdown-mode-version "2.5" 59 "Markdown mode version number.") 60 61 (defconst markdown-output-buffer-name "*markdown-output*" 62 "Name of temporary buffer for markdown command output.") 63 64 65 ;;; Global Variables ========================================================== 66 67 (defvar markdown-reference-label-history nil 68 "History of used reference labels.") 69 70 (defvar markdown-live-preview-mode nil 71 "Sentinel variable for command `markdown-live-preview-mode'.") 72 73 (defvar markdown-gfm-language-history nil 74 "History list of languages used in the current buffer in GFM code blocks.") 75 76 77 ;;; Customizable Variables ==================================================== 78 79 (defvar markdown-mode-hook nil 80 "Hook run when entering Markdown mode.") 81 82 (defvar markdown-before-export-hook nil 83 "Hook run before running Markdown to export XHTML output. 84 The hook may modify the buffer, which will be restored to it's 85 original state after exporting is complete.") 86 87 (defvar markdown-after-export-hook nil 88 "Hook run after XHTML output has been saved. 89 Any changes to the output buffer made by this hook will be saved.") 90 91 (defgroup markdown nil 92 "Major mode for editing text files in Markdown format." 93 :prefix "markdown-" 94 :group 'text 95 :link '(url-link "https://jblevins.org/projects/markdown-mode/")) 96 97 (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") 98 when (executable-find cmd) 99 return (file-name-nondirectory it)))) 100 (or command "markdown")) 101 "Command to run markdown." 102 :group 'markdown 103 :type '(choice (string :tag "Shell command") (repeat (string)) function)) 104 105 (defcustom markdown-command-needs-filename nil 106 "Set to non-nil if `markdown-command' does not accept input from stdin. 107 Instead, it will be passed a filename as the final command line 108 option. As a result, you will only be able to run Markdown from 109 buffers which are visiting a file." 110 :group 'markdown 111 :type 'boolean) 112 113 (defcustom markdown-open-command nil 114 "Command used for opening Markdown files directly. 115 For example, a standalone Markdown previewer. This command will 116 be called with a single argument: the filename of the current 117 buffer. It can also be a function, which will be called without 118 arguments." 119 :group 'markdown 120 :type '(choice file function (const :tag "None" nil))) 121 122 (defcustom markdown-open-image-command nil 123 "Command used for opening image files directly. 124 This is used at `markdown-follow-link-at-point'." 125 :group 'markdown 126 :type '(choice file function (const :tag "None" nil))) 127 128 (defcustom markdown-hr-strings 129 '("-------------------------------------------------------------------------------" 130 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" 131 "---------------------------------------" 132 "* * * * * * * * * * * * * * * * * * * *" 133 "---------" 134 "* * * * *") 135 "Strings to use when inserting horizontal rules. 136 The first string in the list will be the default when inserting a 137 horizontal rule. Strings should be listed in decreasing order of 138 prominence (as in headings from level one to six) for use with 139 promotion and demotion functions." 140 :group 'markdown 141 :type '(repeat string)) 142 143 (defcustom markdown-bold-underscore nil 144 "Use two underscores when inserting bold text instead of two asterisks." 145 :group 'markdown 146 :type 'boolean) 147 148 (defcustom markdown-italic-underscore nil 149 "Use underscores when inserting italic text instead of asterisks." 150 :group 'markdown 151 :type 'boolean) 152 153 (defcustom markdown-marginalize-headers nil 154 "When non-nil, put opening atx header markup in a left margin. 155 156 This setting goes well with `markdown-asymmetric-header'. But 157 sadly it conflicts with `linum-mode' since they both use the 158 same margin." 159 :group 'markdown 160 :type 'boolean 161 :safe 'booleanp 162 :package-version '(markdown-mode . "2.4")) 163 164 (defcustom markdown-marginalize-headers-margin-width 6 165 "Character width of margin used for marginalized headers. 166 The default value is based on there being six heading levels 167 defined by Markdown and HTML. Increasing this produces extra 168 whitespace on the left. Decreasing it may be preferred when 169 fewer than six nested heading levels are used." 170 :group 'markdown 171 :type 'natnump 172 :safe 'natnump 173 :package-version '(markdown-mode . "2.4")) 174 175 (defcustom markdown-asymmetric-header nil 176 "Determines if atx header style will be asymmetric. 177 Set to a non-nil value to use asymmetric header styling, placing 178 header markup only at the beginning of the line. By default, 179 balanced markup will be inserted at the beginning and end of the 180 line around the header title." 181 :group 'markdown 182 :type 'boolean) 183 184 (defcustom markdown-indent-function 'markdown-indent-line 185 "Function to use to indent." 186 :group 'markdown 187 :type 'function) 188 189 (defcustom markdown-indent-on-enter t 190 "Determines indentation behavior when pressing \\[newline]. 191 Possible settings are nil, t, and 'indent-and-new-item. 192 193 When non-nil, pressing \\[newline] will call `newline-and-indent' 194 to indent the following line according to the context using 195 `markdown-indent-function'. In this case, note that 196 \\[electric-newline-and-maybe-indent] can still be used to insert 197 a newline without indentation. 198 199 When set to 'indent-and-new-item and the point is in a list item 200 when \\[newline] is pressed, the list will be continued on the next 201 line, where a new item will be inserted. 202 203 When set to nil, simply call `newline' as usual. In this case, 204 you can still indent lines using \\[markdown-cycle] and continue 205 lists with \\[markdown-insert-list-item]. 206 207 Note that this assumes the variable `electric-indent-mode' is 208 non-nil (enabled). When it is *disabled*, the behavior of 209 \\[newline] and `\\[electric-newline-and-maybe-indent]' are 210 reversed." 211 :group 'markdown 212 :type '(choice (const :tag "Don't automatically indent" nil) 213 (const :tag "Automatically indent" t) 214 (const :tag "Automatically indent and insert new list items" indent-and-new-item))) 215 216 (defcustom markdown-enable-wiki-links nil 217 "Syntax highlighting for wiki links. 218 Set this to a non-nil value to turn on wiki link support by default. 219 Support can be toggled later using the `markdown-toggle-wiki-links' 220 function or \\[markdown-toggle-wiki-links]." 221 :group 'markdown 222 :type 'boolean 223 :safe 'booleanp 224 :package-version '(markdown-mode . "2.2")) 225 226 (defcustom markdown-wiki-link-alias-first t 227 "When non-nil, treat aliased wiki links like [[alias text|PageName]]. 228 Otherwise, they will be treated as [[PageName|alias text]]." 229 :group 'markdown 230 :type 'boolean 231 :safe 'booleanp) 232 233 (defcustom markdown-wiki-link-search-subdirectories nil 234 "When non-nil, search for wiki link targets in subdirectories. 235 This is the default search behavior for GitHub and is 236 automatically set to t in `gfm-mode'." 237 :group 'markdown 238 :type 'boolean 239 :safe 'booleanp 240 :package-version '(markdown-mode . "2.2")) 241 242 (defcustom markdown-wiki-link-search-parent-directories nil 243 "When non-nil, search for wiki link targets in parent directories. 244 This is the default search behavior of Ikiwiki." 245 :group 'markdown 246 :type 'boolean 247 :safe 'booleanp 248 :package-version '(markdown-mode . "2.2")) 249 250 (defcustom markdown-wiki-link-search-type nil 251 "Searching type for markdown wiki link. 252 253 sub-directories: search for wiki link targets in sub directories 254 parent-directories: search for wiki link targets in parent directories 255 project: search for wiki link targets under project root" 256 :group 'markdown 257 :type '(set 258 (const :tag "search wiki link from subdirectories" sub-directories) 259 (const :tag "search wiki link from parent directories" parent-directories) 260 (const :tag "search wiki link under project root" project)) 261 :package-version '(markdown-mode . "2.5")) 262 263 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") 264 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") 265 266 (defcustom markdown-wiki-link-fontify-missing nil 267 "When non-nil, change wiki link face according to existence of target files. 268 This is expensive because it requires checking for the file each time the buffer 269 changes or the user switches windows. It is disabled by default because it may 270 cause lag when typing on slower machines." 271 :group 'markdown 272 :type 'boolean 273 :safe 'booleanp 274 :package-version '(markdown-mode . "2.2")) 275 276 (defcustom markdown-uri-types 277 '("acap" "cid" "data" "dav" "fax" "file" "ftp" 278 "gopher" "http" "https" "imap" "ldap" "mailto" 279 "mid" "message" "modem" "news" "nfs" "nntp" 280 "pop" "prospero" "rtsp" "service" "sip" "tel" 281 "telnet" "tip" "urn" "vemmi" "wais") 282 "Link types for syntax highlighting of URIs." 283 :group 'markdown 284 :type '(repeat (string :tag "URI scheme"))) 285 286 (defcustom markdown-url-compose-char 287 '(?∞ ?… ?⋯ ?# ?★ ?⚓) 288 "Placeholder character for hidden URLs. 289 This may be a single character or a list of characters. In case 290 of a list, the first one that satisfies `char-displayable-p' will 291 be used." 292 :type '(choice 293 (character :tag "Single URL replacement character") 294 (repeat :tag "List of possible URL replacement characters" 295 character)) 296 :package-version '(markdown-mode . "2.3")) 297 298 (defcustom markdown-blockquote-display-char 299 '("▌" "┃" ">") 300 "String to display when hiding blockquote markup. 301 This may be a single string or a list of string. In case of a 302 list, the first one that satisfies `char-displayable-p' will be 303 used." 304 :type 'string 305 :type '(choice 306 (string :tag "Single blockquote display string") 307 (repeat :tag "List of possible blockquote display strings" string)) 308 :package-version '(markdown-mode . "2.3")) 309 310 (defcustom markdown-hr-display-char 311 '(?─ ?━ ?-) 312 "Character for hiding horizontal rule markup. 313 This may be a single character or a list of characters. In case 314 of a list, the first one that satisfies `char-displayable-p' will 315 be used." 316 :group 'markdown 317 :type '(choice 318 (character :tag "Single HR display character") 319 (repeat :tag "List of possible HR display characters" character)) 320 :package-version '(markdown-mode . "2.3")) 321 322 (defcustom markdown-definition-display-char 323 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) 324 "Character for replacing definition list markup. 325 This may be a single character or a list of characters. In case 326 of a list, the first one that satisfies `char-displayable-p' will 327 be used." 328 :type '(choice 329 (character :tag "Single definition list character") 330 (repeat :tag "List of possible definition list characters" character)) 331 :package-version '(markdown-mode . "2.3")) 332 333 (defcustom markdown-enable-math nil 334 "Syntax highlighting for inline LaTeX and itex expressions. 335 Set this to a non-nil value to turn on math support by default. 336 Math support can be enabled, disabled, or toggled later using 337 `markdown-toggle-math' or \\[markdown-toggle-math]." 338 :group 'markdown 339 :type 'boolean 340 :safe 'booleanp) 341 (make-variable-buffer-local 'markdown-enable-math) 342 343 (defcustom markdown-enable-html t 344 "Enable font-lock support for HTML tags and attributes." 345 :group 'markdown 346 :type 'boolean 347 :safe 'booleanp 348 :package-version '(markdown-mode . "2.4")) 349 350 (defcustom markdown-enable-highlighting-syntax nil 351 "Enable highlighting syntax." 352 :group 'markdown 353 :type 'boolean 354 :safe 'booleanp 355 :package-version '(markdown-mode . "2.5")) 356 357 (defcustom markdown-css-paths nil 358 "List of URLs of CSS files to link to in the output XHTML." 359 :group 'markdown 360 :type '(repeat (string :tag "CSS File Path"))) 361 362 (defcustom markdown-content-type "text/html" 363 "Content type string for the http-equiv header in XHTML output. 364 When set to an empty string, this attribute is omitted. Defaults to 365 `text/html'." 366 :group 'markdown 367 :type 'string) 368 369 (defcustom markdown-coding-system nil 370 "Character set string for the http-equiv header in XHTML output. 371 Defaults to `buffer-file-coding-system' (and falling back to 372 `utf-8' when not available). Common settings are `iso-8859-1' 373 and `iso-latin-1'. Use `list-coding-systems' for more choices." 374 :group 'markdown 375 :type 'coding-system) 376 377 (defcustom markdown-export-kill-buffer t 378 "Kill output buffer after HTML export. 379 When non-nil, kill the HTML output buffer after 380 exporting with `markdown-export'." 381 :group 'markdown 382 :type 'boolean 383 :safe 'booleanp 384 :package-version '(markdown-mode . "2.4")) 385 386 (defcustom markdown-xhtml-header-content "" 387 "Additional content to include in the XHTML <head> block." 388 :group 'markdown 389 :type 'string) 390 391 (defcustom markdown-xhtml-body-preamble "" 392 "Content to include in the XHTML <body> block, before the output." 393 :group 'markdown 394 :type 'string 395 :safe 'stringp 396 :package-version '(markdown-mode . "2.4")) 397 398 (defcustom markdown-xhtml-body-epilogue "" 399 "Content to include in the XHTML <body> block, after the output." 400 :group 'markdown 401 :type 'string 402 :safe 'stringp 403 :package-version '(markdown-mode . "2.4")) 404 405 (defcustom markdown-xhtml-standalone-regexp 406 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" 407 "Regexp indicating whether `markdown-command' output is standalone XHTML." 408 :group 'markdown 409 :type 'regexp) 410 411 (defcustom markdown-link-space-sub-char "_" 412 "Character to use instead of spaces when mapping wiki links to filenames." 413 :group 'markdown 414 :type 'string) 415 416 (defcustom markdown-reference-location 'header 417 "Position where new reference definitions are inserted in the document." 418 :group 'markdown 419 :type '(choice (const :tag "At the end of the document" end) 420 (const :tag "Immediately after the current block" immediately) 421 (const :tag "At the end of the subtree" subtree) 422 (const :tag "Before next header" header))) 423 424 (defcustom markdown-footnote-location 'end 425 "Position where new footnotes are inserted in the document." 426 :group 'markdown 427 :type '(choice (const :tag "At the end of the document" end) 428 (const :tag "Immediately after the current block" immediately) 429 (const :tag "At the end of the subtree" subtree) 430 (const :tag "Before next header" header))) 431 432 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) 433 "Display specification for footnote markers and inline footnotes. 434 By default, footnote text is reduced in size and raised. Set to 435 nil to disable this." 436 :group 'markdown 437 :type '(choice (sexp :tag "Display specification") 438 (const :tag "Don't set display property" nil)) 439 :package-version '(markdown-mode . "2.4")) 440 441 (defcustom markdown-sub-superscript-display 442 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) 443 "Display specification for subscript and superscripts. 444 The car is used for subscript, the cdr is used for superscripts." 445 :group 'markdown 446 :type '(cons (choice (sexp :tag "Subscript form") 447 (const :tag "No lowering" nil)) 448 (choice (sexp :tag "Superscript form") 449 (const :tag "No raising" nil))) 450 :package-version '(markdown-mode . "2.4")) 451 452 (defcustom markdown-unordered-list-item-prefix " * " 453 "String inserted before unordered list items." 454 :group 'markdown 455 :type 'string) 456 457 (defcustom markdown-ordered-list-enumeration t 458 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. 459 While nil, always uses '1.' for the marker" 460 :group 'markdown 461 :type 'boolean 462 :package-version '(markdown-mode . "2.5")) 463 464 (defcustom markdown-nested-imenu-heading-index t 465 "Use nested or flat imenu heading index. 466 A nested index may provide more natural browsing from the menu, 467 but a flat list may allow for faster keyboard navigation via tab 468 completion." 469 :group 'markdown 470 :type 'boolean 471 :safe 'booleanp 472 :package-version '(markdown-mode . "2.2")) 473 474 (defcustom markdown-add-footnotes-to-imenu t 475 "Add footnotes to end of imenu heading index." 476 :group 'markdown 477 :type 'boolean 478 :safe 'booleanp 479 :package-version '(markdown-mode . "2.4")) 480 481 (defcustom markdown-make-gfm-checkboxes-buttons t 482 "When non-nil, make GFM checkboxes into buttons." 483 :group 'markdown 484 :type 'boolean) 485 486 (defcustom markdown-use-pandoc-style-yaml-metadata nil 487 "When non-nil, allow YAML metadata anywhere in the document." 488 :group 'markdown 489 :type 'boolean) 490 491 (defcustom markdown-split-window-direction 'any 492 "Preference for splitting windows for static and live preview. 493 The default value is 'any, which instructs Emacs to use 494 `split-window-sensibly' to automatically choose how to split 495 windows based on the values of `split-width-threshold' and 496 `split-height-threshold' and the available windows. To force 497 vertically split (left and right) windows, set this to 'vertical 498 or 'right. To force horizontally split (top and bottom) windows, 499 set this to 'horizontal or 'below. 500 501 If this value is 'any and `display-buffer-alist' is set then 502 `display-buffer' is used for open buffer function" 503 :group 'markdown 504 :type '(choice (const :tag "Automatic" any) 505 (const :tag "Right (vertical)" right) 506 (const :tag "Below (horizontal)" below)) 507 :package-version '(markdown-mode . "2.2")) 508 509 (defcustom markdown-live-preview-window-function 510 #'markdown-live-preview-window-eww 511 "Function to display preview of Markdown output within Emacs. 512 Function must update the buffer containing the preview and return 513 the buffer." 514 :group 'markdown 515 :type 'function) 516 517 (defcustom markdown-live-preview-delete-export 'delete-on-destroy 518 "Delete exported HTML file when using `markdown-live-preview-export'. 519 If set to 'delete-on-export, delete on every export. When set to 520 'delete-on-destroy delete when quitting from command 521 `markdown-live-preview-mode'. Never delete if set to nil." 522 :group 'markdown 523 :type '(choice 524 (const :tag "Delete on every export" delete-on-export) 525 (const :tag "Delete when quitting live preview" delete-on-destroy) 526 (const :tag "Never delete" nil))) 527 528 (defcustom markdown-list-indent-width 4 529 "Depth of indentation for markdown lists. 530 Used in `markdown-demote-list-item' and 531 `markdown-promote-list-item'." 532 :group 'markdown 533 :type 'integer) 534 535 (defcustom markdown-enable-prefix-prompts t 536 "Display prompts for certain prefix commands. 537 Set to nil to disable these prompts." 538 :group 'markdown 539 :type 'boolean 540 :safe 'booleanp 541 :package-version '(markdown-mode . "2.3")) 542 543 (defcustom markdown-gfm-additional-languages nil 544 "Extra languages made available when inserting GFM code blocks. 545 Language strings must have be trimmed of whitespace and not 546 contain any curly braces. They may be of arbitrary 547 capitalization, though." 548 :group 'markdown 549 :type '(repeat (string :validate markdown-validate-language-string))) 550 551 (defcustom markdown-gfm-use-electric-backquote t 552 "Use `markdown-electric-backquote' when backquote is hit three times." 553 :group 'markdown 554 :type 'boolean) 555 556 (defcustom markdown-gfm-downcase-languages t 557 "If non-nil, downcase suggested languages. 558 This applies to insertions done with 559 `markdown-electric-backquote'." 560 :group 'markdown 561 :type 'boolean) 562 563 (defcustom markdown-edit-code-block-default-mode 'normal-mode 564 "Default mode to use for editing code blocks. 565 This mode is used when automatic detection fails, such as for GFM 566 code blocks with no language specified." 567 :group 'markdown 568 :type '(choice function (const :tag "None" nil)) 569 :package-version '(markdown-mode . "2.4")) 570 571 (defcustom markdown-gfm-uppercase-checkbox nil 572 "If non-nil, use [X] for completed checkboxes, [x] otherwise." 573 :group 'markdown 574 :type 'boolean 575 :safe 'booleanp) 576 577 (defcustom markdown-hide-urls nil 578 "Hide URLs of inline links and reference tags of reference links. 579 Such URLs will be replaced by a single customizable 580 character, defined by `markdown-url-compose-char', but are still part 581 of the buffer. Links can be edited interactively with 582 \\[markdown-insert-link] or, for example, by deleting the final 583 parenthesis to remove the invisibility property. You can also 584 hover your mouse pointer over the link text to see the URL. 585 Set this to a non-nil value to turn this feature on by default. 586 You can interactively set the value of this variable by calling 587 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], 588 or from the menu Markdown > Links & Images menu." 589 :group 'markdown 590 :type 'boolean 591 :safe 'booleanp 592 :package-version '(markdown-mode . "2.3")) 593 (make-variable-buffer-local 'markdown-hide-urls) 594 595 (defcustom markdown-translate-filename-function #'identity 596 "Function to use to translate filenames when following links. 597 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] 598 call this function with the filename as only argument whenever 599 they encounter a filename (instead of a URL) to be visited and 600 use its return value instead of the filename in the link. For 601 example, if absolute filenames are actually relative to a server 602 root directory, you can set 603 `markdown-translate-filename-function' to a function that 604 prepends the root directory to the given filename." 605 :group 'markdown 606 :type 'function 607 :risky t 608 :package-version '(markdown-mode . "2.4")) 609 610 (defcustom markdown-max-image-size nil 611 "Maximum width and height for displayed inline images. 612 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). 613 When nil, use the actual size. Otherwise, use ImageMagick to 614 resize larger images to be of the given maximum dimensions. This 615 requires Emacs to be built with ImageMagick support." 616 :group 'markdown 617 :package-version '(markdown-mode . "2.4") 618 :type '(choice 619 (const :tag "Use actual image width" nil) 620 (cons (choice (sexp :tag "Maximum width in pixels") 621 (const :tag "No maximum width" nil)) 622 (choice (sexp :tag "Maximum height in pixels") 623 (const :tag "No maximum height" nil))))) 624 625 (defcustom markdown-mouse-follow-link t 626 "Non-nil means mouse on a link will follow the link. 627 This variable must be set before loading markdown-mode." 628 :group 'markdown 629 :type 'boolean 630 :safe 'booleanp 631 :package-version '(markdown-mode . "2.5")) 632 633 (defcustom markdown-table-align-p t 634 "Non-nil means that table is aligned after table operation." 635 :group 'markdown 636 :type 'boolean 637 :safe 'booleanp 638 :package-version '(markdown-mode . "2.5")) 639 640 641 ;;; Markdown-Specific `rx' Macro ============================================== 642 643 ;; Based on python-rx from python.el. 644 (eval-and-compile 645 (defconst markdown-rx-constituents 646 `((newline . ,(rx "\n")) 647 ;; Note: #405 not consider markdown-list-indent-width however this is never used 648 (indent . ,(rx (or (repeat 4 " ") "\t"))) 649 (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end)))) 650 (numeral . ,(rx (and (one-or-more (any "0-9#")) "."))) 651 (bullet . ,(rx (any "*+:-"))) 652 (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".") 653 (any "*+:-")))) 654 (checkbox . ,(rx "[" (any " xX") "]"))) 655 "Markdown-specific sexps for `markdown-rx'") 656 657 (defun markdown-rx-to-string (form &optional no-group) 658 "Markdown mode specialized `rx-to-string' function. 659 This variant supports named Markdown expressions in FORM. 660 NO-GROUP non-nil means don't put shy groups around the result." 661 (let ((rx-constituents (append markdown-rx-constituents rx-constituents))) 662 (rx-to-string form no-group))) 663 664 (defmacro markdown-rx (&rest regexps) 665 "Markdown mode specialized rx macro. 666 This variant of `rx' supports common Markdown named REGEXPS." 667 (cond ((null regexps) 668 (error "No regexp")) 669 ((cdr regexps) 670 (markdown-rx-to-string `(and ,@regexps) t)) 671 (t 672 (markdown-rx-to-string (car regexps) t))))) 673 674 675 ;;; Regular Expressions ======================================================= 676 677 (defconst markdown-regex-comment-start 678 "<!--" 679 "Regular expression matches HTML comment opening.") 680 681 (defconst markdown-regex-comment-end 682 "--[ \t]*>" 683 "Regular expression matches HTML comment closing.") 684 685 (defconst markdown-regex-link-inline 686 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" 687 "Regular expression for a [text](file) or an image link . 688 Group 1 matches the leading exclamation point (optional). 689 Group 2 matches the opening square bracket. 690 Group 3 matches the text inside the square brackets. 691 Group 4 matches the closing square bracket. 692 Group 5 matches the opening parenthesis. 693 Group 6 matches the URL. 694 Group 7 matches the title (optional). 695 Group 8 matches the closing parenthesis.") 696 697 (defconst markdown-regex-link-reference 698 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" 699 "Regular expression for a reference link [text][id]. 700 Group 1 matches the leading exclamation point (optional). 701 Group 2 matches the opening square bracket for the link text. 702 Group 3 matches the text inside the square brackets. 703 Group 4 matches the closing square bracket for the link text. 704 Group 5 matches the opening square bracket for the reference label. 705 Group 6 matches the reference label. 706 Group 7 matches the closing square bracket for the reference label.") 707 708 (defconst markdown-regex-reference-definition 709 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" 710 "Regular expression for a reference definition. 711 Group 1 matches the opening square bracket. 712 Group 2 matches the reference label. 713 Group 3 matches the closing square bracket. 714 Group 4 matches the colon. 715 Group 5 matches the URL. 716 Group 6 matches the title attribute (optional).") 717 718 (defconst markdown-regex-footnote 719 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" 720 "Regular expression for a footnote marker [^fn]. 721 Group 1 matches the opening square bracket and carat. 722 Group 2 matches only the label, without the surrounding markup. 723 Group 3 matches the closing square bracket.") 724 725 (defconst markdown-regex-header 726 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$" 727 "Regexp identifying Markdown headings. 728 Group 1 matches the text of a setext heading. 729 Group 2 matches the underline of a level-1 setext heading. 730 Group 3 matches the underline of a level-2 setext heading. 731 Group 4 matches the opening hash marks of an atx heading and whitespace. 732 Group 5 matches the text, without surrounding whitespace, of an atx heading. 733 Group 6 matches the closing whitespace and hash marks of an atx heading.") 734 735 (defconst markdown-regex-header-setext 736 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" 737 "Regular expression for generic setext-style (underline) headers.") 738 739 (defconst markdown-regex-header-atx 740 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" 741 "Regular expression for generic atx-style (hash mark) headers.") 742 743 (defconst markdown-regex-hr 744 (rx line-start 745 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) 746 (and (repeat 3 (and "-" (? " "))) (* (any "- "))) 747 (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) 748 line-end) 749 "Regular expression for matching Markdown horizontal rules.") 750 751 (defconst markdown-regex-code 752 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" 753 "Regular expression for matching inline code fragments. 754 755 Group 1 matches the entire code fragment including the backquotes. 756 Group 2 matches the opening backquotes. 757 Group 3 matches the code fragment itself, without backquotes. 758 Group 4 matches the closing backquotes. 759 760 The leading, unnumbered group ensures that the leading backquote 761 character is not escaped. 762 The last group, also unnumbered, requires that the character 763 following the code fragment is not a backquote. 764 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, 765 but not two newlines in a row.") 766 767 (defconst markdown-regex-kbd 768 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" 769 "Regular expression for matching <kbd> tags. 770 Groups 1 and 3 match the opening and closing tags. 771 Group 2 matches the key sequence.") 772 773 (defconst markdown-regex-gfm-code-block-open 774 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" 775 "Regular expression matching opening of GFM code blocks. 776 Group 1 matches the opening three backquotes and any following whitespace. 777 Group 2 matches the opening brace (optional) and surrounding whitespace. 778 Group 3 matches the language identifier (optional). 779 Group 4 matches the info string (optional). 780 Group 5 matches the closing brace (optional), whitespace, and newline. 781 Groups need to agree with `markdown-regex-tilde-fence-begin'.") 782 783 (defconst markdown-regex-gfm-code-block-close 784 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" 785 "Regular expression matching closing of GFM code blocks. 786 Group 1 matches the closing three backquotes. 787 Group 2 matches any whitespace and the final newline.") 788 789 (defconst markdown-regex-pre 790 "^\\( \\|\t\\).*$" 791 "Regular expression for matching preformatted text sections.") 792 793 (defconst markdown-regex-list 794 (markdown-rx line-start 795 ;; 1. Leading whitespace 796 (group (* blank)) 797 ;; 2. List marker: a numeral, bullet, or colon 798 (group list-marker) 799 ;; 3. Trailing whitespace 800 (group (+ blank)) 801 ;; 4. Optional checkbox for GFM task list items 802 (opt (group (and checkbox (* blank))))) 803 "Regular expression for matching list items.") 804 805 (defconst markdown-regex-bold 806 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" 807 "Regular expression for matching bold text. 808 Group 1 matches the character before the opening asterisk or 809 underscore, if any, ensuring that it is not a backslash escape. 810 Group 2 matches the entire expression, including delimiters. 811 Groups 3 and 5 matches the opening and closing delimiters. 812 Group 4 matches the text inside the delimiters.") 813 814 (defconst markdown-regex-italic 815 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" 816 "Regular expression for matching italic text. 817 The leading unnumbered matches the character before the opening 818 asterisk or underscore, if any, ensuring that it is not a 819 backslash escape. 820 Group 1 matches the entire expression, including delimiters. 821 Groups 2 and 4 matches the opening and closing delimiters. 822 Group 3 matches the text inside the delimiters.") 823 824 (defconst markdown-regex-strike-through 825 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" 826 "Regular expression for matching strike-through text. 827 Group 1 matches the character before the opening tilde, if any, 828 ensuring that it is not a backslash escape. 829 Group 2 matches the entire expression, including delimiters. 830 Groups 3 and 5 matches the opening and closing delimiters. 831 Group 4 matches the text inside the delimiters.") 832 833 (defconst markdown-regex-gfm-italic 834 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" 835 "Regular expression for matching italic text in GitHub Flavored Markdown. 836 Underscores in words are not treated as special. 837 Group 1 matches the entire expression, including delimiters. 838 Groups 2 and 4 matches the opening and closing delimiters. 839 Group 3 matches the text inside the delimiters.") 840 841 (defconst markdown-regex-blockquote 842 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" 843 "Regular expression for matching blockquote lines. 844 Also accounts for a potential capital letter preceding the angle 845 bracket, for use with Leanpub blocks (asides, warnings, info 846 blocks, etc.). 847 Group 1 matches the leading angle bracket. 848 Group 2 matches the separating whitespace. 849 Group 3 matches the text.") 850 851 (defconst markdown-regex-line-break 852 "[^ \n\t][ \t]*\\( \\)\n" 853 "Regular expression for matching line breaks.") 854 855 (defconst markdown-regex-wiki-link 856 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" 857 "Regular expression for matching wiki links. 858 This matches typical bracketed [[WikiLinks]] as well as 'aliased' 859 wiki links of the form [[PageName|link text]]. 860 The meanings of the first and second components depend 861 on the value of `markdown-wiki-link-alias-first'. 862 863 Group 1 matches the entire link. 864 Group 2 matches the opening square brackets. 865 Group 3 matches the first component of the wiki link. 866 Group 4 matches the pipe separator, when present. 867 Group 5 matches the second component of the wiki link, when present. 868 Group 6 matches the closing square brackets.") 869 870 (defconst markdown-regex-uri 871 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") 872 "Regular expression for matching inline URIs.") 873 874 (defconst markdown-regex-angle-uri 875 (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)") 876 "Regular expression for matching inline URIs in angle brackets.") 877 878 (defconst markdown-regex-email 879 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" 880 "Regular expression for matching inline email addresses.") 881 882 (defsubst markdown-make-regex-link-generic () 883 "Make regular expression for matching any recognized link." 884 (concat "\\(?:" markdown-regex-link-inline 885 (when markdown-enable-wiki-links 886 (concat "\\|" markdown-regex-wiki-link)) 887 "\\|" markdown-regex-link-reference 888 "\\|" markdown-regex-angle-uri "\\)")) 889 890 (defconst markdown-regex-gfm-checkbox 891 " \\(\\[[ xX]\\]\\) " 892 "Regular expression for matching GFM checkboxes. 893 Group 1 matches the text to become a button.") 894 895 (defconst markdown-regex-blank-line 896 "^[[:blank:]]*$" 897 "Regular expression that matches a blank line.") 898 899 (defconst markdown-regex-block-separator 900 "\n[\n\t\f ]*\n" 901 "Regular expression for matching block boundaries.") 902 903 (defconst markdown-regex-block-separator-noindent 904 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") 905 "Regexp for block separators before lines with no indentation.") 906 907 (defconst markdown-regex-math-inline-single 908 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" 909 "Regular expression for itex $..$ math mode expressions. 910 Groups 1 and 3 match the opening and closing dollar signs. 911 Group 2 matches the mathematical expression contained within.") 912 913 (defconst markdown-regex-math-inline-double 914 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" 915 "Regular expression for itex $$..$$ math mode expressions. 916 Groups 1 and 3 match opening and closing dollar signs. 917 Group 2 matches the mathematical expression contained within.") 918 919 (defconst markdown-regex-math-display 920 (rx line-start (* blank) 921 (group (group (repeat 1 2 "\\")) "[") 922 (group (*? anything)) 923 (group (backref 2) "]") 924 line-end) 925 "Regular expression for \[..\] or \\[..\\] display math. 926 Groups 1 and 4 match the opening and closing markup. 927 Group 3 matches the mathematical expression contained within. 928 Group 2 matches the opening slashes, and is used internally to 929 match the closing slashes.") 930 931 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) 932 "Return regexp matching a tilde code fence at least NUM-TILDES long. 933 END-OF-LINE is the regexp construct to indicate end of line; $ if 934 missing." 935 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" 936 (or end-of-line "$"))) 937 938 (defconst markdown-regex-tilde-fence-begin 939 (markdown-make-tilde-fence-regex 940 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") 941 "Regular expression for matching tilde-fenced code blocks. 942 Group 1 matches the opening tildes. 943 Group 2 matches (optional) opening brace and surrounding whitespace. 944 Group 3 matches the language identifier (optional). 945 Group 4 matches the info string (optional). 946 Group 5 matches the closing brace (optional) and any surrounding whitespace. 947 Groups need to agree with `markdown-regex-gfm-code-block-open'.") 948 949 (defconst markdown-regex-declarative-metadata 950 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" 951 "Regular expression for matching declarative metadata statements. 952 This matches MultiMarkdown metadata as well as YAML and TOML 953 assignments such as the following: 954 955 variable: value 956 957 or 958 959 variable = value") 960 961 (defconst markdown-regex-pandoc-metadata 962 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" 963 "Regular expression for matching Pandoc metadata.") 964 965 (defconst markdown-regex-yaml-metadata-border 966 "\\(-\\{3\\}\\)$" 967 "Regular expression for matching YAML metadata.") 968 969 (defconst markdown-regex-yaml-pandoc-metadata-end-border 970 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" 971 "Regular expression for matching YAML metadata end borders.") 972 973 (defsubst markdown-get-yaml-metadata-start-border () 974 "Return YAML metadata start border depending upon whether Pandoc is used." 975 (concat 976 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") 977 markdown-regex-yaml-metadata-border)) 978 979 (defsubst markdown-get-yaml-metadata-end-border (_) 980 "Return YAML metadata end border depending upon whether Pandoc is used." 981 (if markdown-use-pandoc-style-yaml-metadata 982 markdown-regex-yaml-pandoc-metadata-end-border 983 markdown-regex-yaml-metadata-border)) 984 985 (defconst markdown-regex-inline-attributes 986 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" 987 "Regular expression for matching inline identifiers or attribute lists. 988 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") 989 990 (defconst markdown-regex-leanpub-sections 991 (concat 992 "^\\({\\)\\(" 993 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) 994 "\\)\\(}\\)[ \t]*\n") 995 "Regular expression for Leanpub section markers and related syntax.") 996 997 (defconst markdown-regex-sub-superscript 998 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" 999 "The regular expression matching a sub- or superscript. 1000 The leading un-numbered group matches the character before the 1001 opening tilde or carat, if any, ensuring that it is not a 1002 backslash escape, carat, or tilde. 1003 Group 1 matches the entire expression, including markup. 1004 Group 2 matches the opening markup--a tilde or carat. 1005 Group 3 matches the text inside the delimiters. 1006 Group 4 matches the closing markup--a tilde or carat.") 1007 1008 (defconst markdown-regex-include 1009 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" 1010 "Regular expression matching common forms of include syntax. 1011 Marked 2, Leanpub, and other processors support some of these forms: 1012 1013 <<[sections/section1.md] 1014 <<(folder/filename) 1015 <<[Code title](folder/filename) 1016 <<{folder/raw_file.html} 1017 1018 Group 1 matches the opening two angle brackets. 1019 Groups 2-4 match the opening square bracket, the text inside, 1020 and the closing square bracket, respectively. 1021 Groups 5-7 match the opening parenthesis, the text inside, and 1022 the closing parenthesis. 1023 Groups 8-10 match the opening brace, the text inside, and the brace.") 1024 1025 (defconst markdown-regex-pandoc-inline-footnote 1026 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" 1027 "Regular expression for Pandoc inline footnote^[footnote text]. 1028 Group 1 matches the opening caret. 1029 Group 2 matches the opening square bracket. 1030 Group 3 matches the footnote text, without the surrounding markup. 1031 Group 4 matches the closing square bracket.") 1032 1033 (defconst markdown-regex-html-attr 1034 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" 1035 "Regular expression for matching HTML attributes and values. 1036 Group 1 matches the attribute name. 1037 Group 2 matches the following whitespace, equals sign, and value, if any. 1038 Group 3 matches the equals sign, if any. 1039 Group 4 matches single-, double-, or un-quoted attribute values.") 1040 1041 (defconst markdown-regex-html-tag 1042 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr 1043 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") 1044 "Regular expression for matching HTML tags. 1045 Groups 1 and 9 match the beginning and ending angle brackets and slashes. 1046 Group 2 matches the tag name. 1047 Group 3 matches all attributes and whitespace following the tag name.") 1048 1049 (defconst markdown-regex-html-entity 1050 "\\(&#?[[:alnum:]]+;\\)" 1051 "Regular expression for matching HTML entities.") 1052 1053 (defconst markdown-regex-highlighting 1054 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" 1055 "Regular expression for matching highlighting text. 1056 Group 1 matches the character before the opening equal, if any, 1057 ensuring that it is not a backslash escape. 1058 Group 2 matches the entire expression, including delimiters. 1059 Groups 3 and 5 matches the opening and closing delimiters. 1060 Group 4 matches the text inside the delimiters.") 1061 1062 1063 ;;; Syntax ==================================================================== 1064 1065 (defvar markdown--syntax-properties 1066 (list 'markdown-tilde-fence-begin nil 1067 'markdown-tilde-fence-end nil 1068 'markdown-fenced-code nil 1069 'markdown-yaml-metadata-begin nil 1070 'markdown-yaml-metadata-end nil 1071 'markdown-yaml-metadata-section nil 1072 'markdown-gfm-block-begin nil 1073 'markdown-gfm-block-end nil 1074 'markdown-gfm-code nil 1075 'markdown-list-item nil 1076 'markdown-pre nil 1077 'markdown-blockquote nil 1078 'markdown-hr nil 1079 'markdown-comment nil 1080 'markdown-heading nil 1081 'markdown-heading-1-setext nil 1082 'markdown-heading-2-setext nil 1083 'markdown-heading-1-atx nil 1084 'markdown-heading-2-atx nil 1085 'markdown-heading-3-atx nil 1086 'markdown-heading-4-atx nil 1087 'markdown-heading-5-atx nil 1088 'markdown-heading-6-atx nil 1089 'markdown-metadata-key nil 1090 'markdown-metadata-value nil 1091 'markdown-metadata-markup nil) 1092 "Property list of all Markdown syntactic properties.") 1093 1094 (defsubst markdown-in-comment-p (&optional pos) 1095 "Return non-nil if POS is in a comment. 1096 If POS is not given, use point instead." 1097 (get-text-property (or pos (point)) 'markdown-comment)) 1098 1099 (defun markdown--face-p (pos faces) 1100 "Return non-nil if face of POS contain FACES." 1101 (let ((face-prop (get-text-property pos 'face))) 1102 (if (listp face-prop) 1103 (cl-loop for face in face-prop 1104 thereis (memq face faces)) 1105 (memq face-prop faces)))) 1106 1107 (defun markdown-syntax-propertize-extend-region (start end) 1108 "Extend START to END region to include an entire block of text. 1109 This helps improve syntax analysis for block constructs. 1110 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. 1111 Function is called repeatedly until it returns nil. For details, see 1112 `syntax-propertize-extend-region-functions'." 1113 (save-match-data 1114 (save-excursion 1115 (let* ((new-start (progn (goto-char start) 1116 (skip-chars-forward "\n") 1117 (if (re-search-backward "\n\n" nil t) 1118 (min start (match-end 0)) 1119 (point-min)))) 1120 (new-end (progn (goto-char end) 1121 (skip-chars-backward "\n") 1122 (if (re-search-forward "\n\n" nil t) 1123 (max end (match-beginning 0)) 1124 (point-max)))) 1125 (code-match (markdown-code-block-at-pos new-start)) 1126 ;; FIXME: The `code-match' can return bogus values 1127 ;; when text has been inserted/deleted! 1128 (new-start (min (or (and code-match (cl-first code-match)) 1129 (point-max)) 1130 new-start)) 1131 (code-match (and (< end (point-max)) 1132 (markdown-code-block-at-pos end))) 1133 (new-end (max (or (and code-match (cl-second code-match)) 0) 1134 new-end))) 1135 1136 (unless (and (eq new-start start) (eq new-end end)) 1137 (cons new-start (min new-end (point-max)))))))) 1138 1139 (defun markdown-font-lock-extend-region-function (start end _) 1140 "Used in `jit-lock-after-change-extend-region-functions'. 1141 Delegates to `markdown-syntax-propertize-extend-region'. START 1142 and END are the previous region to refontify." 1143 (let ((res (markdown-syntax-propertize-extend-region start end))) 1144 (when res 1145 ;; syntax-propertize-function is not called when character at 1146 ;; (point-max) is deleted, but font-lock-extend-region-functions 1147 ;; are called. Force a syntax property update in that case. 1148 (when (= end (point-max)) 1149 ;; This function is called in a buffer modification hook. 1150 ;; `markdown-syntax-propertize' doesn't save the match data, 1151 ;; so we have to do it here. 1152 (save-match-data 1153 (markdown-syntax-propertize (car res) (cdr res)))) 1154 (setq jit-lock-start (car res) 1155 jit-lock-end (cdr res))))) 1156 1157 (defun markdown--cur-list-item-bounds () 1158 "Return a list describing the list item at point. 1159 Assumes that match data is set for `markdown-regex-list'. See the 1160 documentation for `markdown-cur-list-item-bounds' for the format of 1161 the returned list." 1162 (save-excursion 1163 (let* ((begin (match-beginning 0)) 1164 (indent (length (match-string-no-properties 1))) 1165 (nonlist-indent (- (match-end 3) (match-beginning 0))) 1166 (marker (buffer-substring-no-properties 1167 (match-beginning 2) (match-end 3))) 1168 (checkbox (match-string-no-properties 4)) 1169 (match (butlast (match-data t))) 1170 (end (markdown-cur-list-item-end nonlist-indent))) 1171 (list begin end indent nonlist-indent marker checkbox match)))) 1172 1173 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) 1174 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. 1175 Here, MARKER is a string representing the type of list and INDENT 1176 is an integer giving the indentation, in spaces, of the current 1177 block. CUR-BOUNDS is a list of the form returned by 1178 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds 1179 values for parent list items. When BOUNDS is nil, it means we are 1180 at baseline (not inside of a nested list)." 1181 (let ((prev-indent (or (cl-third (car bounds)) 0))) 1182 (cond 1183 ;; New list item at baseline. 1184 ((and marker (null bounds)) 1185 (list cur-bounds)) 1186 ;; List item with greater indentation (four or more spaces). 1187 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. 1188 ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) 1189 (cons cur-bounds bounds)) 1190 ;; List item with greater or equal indentation (less than four spaces). 1191 ;; Keep list level the same by replacing the car of BOUNDS. 1192 ((and marker (>= indent prev-indent)) 1193 (cons cur-bounds (cdr bounds))) 1194 ;; Lesser indentation level. 1195 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser 1196 ;; indentation could move back more than one list level). Note 1197 ;; that this block need not be the beginning of list item. 1198 ((< indent prev-indent) 1199 (while (and (> (length bounds) 1) 1200 (setq prev-indent (cl-third (cadr bounds))) 1201 (< indent (+ prev-indent markdown-list-indent-width))) 1202 (setq bounds (cdr bounds))) 1203 (cons cur-bounds bounds)) 1204 ;; Otherwise, do nothing. 1205 (t bounds)))) 1206 1207 (defun markdown-syntax-propertize-list-items (start end) 1208 "Propertize list items from START to END. 1209 Stores nested list item information in the `markdown-list-item' 1210 text property to make later syntax analysis easier. The value of 1211 this property is a list with elements of the form (begin . end) 1212 giving the bounds of the current and parent list items." 1213 (save-excursion 1214 (goto-char start) 1215 (let ((prev-list-line -100) 1216 bounds level pre-regexp) 1217 ;; Find a baseline point with zero list indentation 1218 (markdown-search-backward-baseline) 1219 ;; Search for all list items between baseline and END 1220 (while (and (< (point) end) 1221 (re-search-forward markdown-regex-list end 'limit)) 1222 ;; Level of list nesting 1223 (setq level (length bounds)) 1224 ;; Pre blocks need to be indented one level past the list level 1225 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) 1226 (beginning-of-line) 1227 (cond 1228 ;; Reset at headings, horizontal rules, and top-level blank lines. 1229 ;; Propertize baseline when in range. 1230 ((markdown-new-baseline) 1231 (setq bounds nil)) 1232 ;; Make sure this is not a line from a pre block 1233 ((and (looking-at-p pre-regexp) 1234 ;; too indented line is also treated as list if previous line is list 1235 (>= (- (line-number-at-pos) prev-list-line) 2))) 1236 ;; If not, then update levels and propertize list item when in range. 1237 (t 1238 (let* ((indent (current-indentation)) 1239 (cur-bounds (markdown--cur-list-item-bounds)) 1240 (first (cl-first cur-bounds)) 1241 (last (cl-second cur-bounds)) 1242 (marker (cl-fifth cur-bounds))) 1243 (setq bounds (markdown--append-list-item-bounds 1244 marker indent cur-bounds bounds)) 1245 (when (and (<= start (point)) (<= (point) end)) 1246 (setq prev-list-line (line-number-at-pos first)) 1247 (put-text-property first last 'markdown-list-item bounds))))) 1248 (end-of-line))))) 1249 1250 (defun markdown-syntax-propertize-pre-blocks (start end) 1251 "Match preformatted text blocks from START to END." 1252 (save-excursion 1253 (goto-char start) 1254 (let (finish) 1255 ;; Use loop for avoiding too many recursive calls 1256 ;; https://github.com/jrblevin/markdown-mode/issues/512 1257 (while (not finish) 1258 (let ((levels (markdown-calculate-list-levels)) 1259 indent pre-regexp close-regexp open close) 1260 (while (and (< (point) end) (not close)) 1261 ;; Search for a region with sufficient indentation 1262 (if (null levels) 1263 (setq indent 1) 1264 (setq indent (1+ (length levels)))) 1265 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) 1266 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) 1267 1268 (cond 1269 ;; If not at the beginning of a line, move forward 1270 ((not (bolp)) (forward-line)) 1271 ;; Move past blank lines 1272 ((markdown-cur-line-blank-p) (forward-line)) 1273 ;; At headers and horizontal rules, reset levels 1274 ((markdown-new-baseline) (forward-line) (setq levels nil)) 1275 ;; If the current line has sufficient indentation, mark out pre block 1276 ;; The opening should be preceded by a blank line. 1277 ((and (markdown-prev-line-blank) (looking-at pre-regexp)) 1278 (setq open (match-beginning 0)) 1279 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) 1280 (not (eobp))) 1281 (forward-line)) 1282 (skip-syntax-backward "-") 1283 (setq close (point))) 1284 ;; If current line has a list marker, update levels, move to end of block 1285 ((looking-at markdown-regex-list) 1286 (setq levels (markdown-update-list-levels 1287 (match-string 2) (current-indentation) levels)) 1288 (markdown-end-of-text-block)) 1289 ;; If this is the end of the indentation level, adjust levels accordingly. 1290 ;; Only match end of indentation level if levels is not the empty list. 1291 ((and (car levels) (looking-at-p close-regexp)) 1292 (setq levels (markdown-update-list-levels 1293 nil (current-indentation) levels)) 1294 (markdown-end-of-text-block)) 1295 (t (markdown-end-of-text-block)))) 1296 1297 (if (and open close) 1298 ;; Set text property data and continue to search 1299 (put-text-property open close 'markdown-pre (list open close)) 1300 (setq finish t)))) 1301 nil))) 1302 1303 (defconst markdown-fenced-block-pairs 1304 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) 1305 (markdown-make-tilde-fence-regex markdown-tilde-fence-end) 1306 markdown-fenced-code) 1307 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) 1308 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) 1309 markdown-yaml-metadata-section) 1310 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) 1311 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) 1312 markdown-gfm-code)) 1313 "Mapping of regular expressions to \"fenced-block\" constructs. 1314 These constructs are distinguished by having a distinctive start 1315 and end pattern, both of which take up an entire line of text, 1316 but no special pattern to identify text within the fenced 1317 blocks (unlike blockquotes and indented-code sections). 1318 1319 Each element within this list takes the form: 1320 1321 ((START-REGEX-OR-FUN START-PROPERTY) 1322 (END-REGEX-OR-FUN END-PROPERTY) 1323 MIDDLE-PROPERTY) 1324 1325 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a 1326 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no 1327 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument 1328 which is the length of the first group of the START-REGEX-OR-FUN match, which 1329 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to 1330 evaluate these into \"real\" regexps. 1331 1332 The *-PROPERTY elements are the text properties applied to each part of the 1333 block construct when it is matched using 1334 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied 1335 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and 1336 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the 1337 `match-data' when the regexp was matched to the text. In the case of 1338 MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with 1339 begin and end set to the edges of the \"middle\" text. This makes fontification 1340 easier.") 1341 1342 (defun markdown-text-property-at-point (prop) 1343 (get-text-property (point) prop)) 1344 1345 (defsubst markdown-maybe-funcall-regexp (object &optional arg) 1346 (cond ((functionp object) 1347 (if arg (funcall object arg) (funcall object))) 1348 ((stringp object) object) 1349 (t (error "Object cannot be turned into regex")))) 1350 1351 (defsubst markdown-get-start-fence-regexp () 1352 "Return regexp to find all \"start\" sections of fenced block constructs. 1353 Which construct is actually contained in the match must be found separately." 1354 (mapconcat 1355 #'identity 1356 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) 1357 markdown-fenced-block-pairs) 1358 "\\|")) 1359 1360 (defun markdown-get-fenced-block-begin-properties () 1361 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) 1362 1363 (defun markdown-get-fenced-block-end-properties () 1364 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) 1365 1366 (defun markdown-get-fenced-block-middle-properties () 1367 (cl-mapcar #'cl-third markdown-fenced-block-pairs)) 1368 1369 (defun markdown-find-previous-prop (prop &optional lim) 1370 "Find previous place where property PROP is non-nil, up to LIM. 1371 Return a cons of (pos . property). pos is point if point contains 1372 non-nil PROP." 1373 (let ((res 1374 (if (get-text-property (point) prop) (point) 1375 (previous-single-property-change 1376 (point) prop nil (or lim (point-min)))))) 1377 (when (and (not (get-text-property res prop)) 1378 (> res (point-min)) 1379 (get-text-property (1- res) prop)) 1380 (cl-decf res)) 1381 (when (and res (get-text-property res prop)) (cons res prop)))) 1382 1383 (defun markdown-find-next-prop (prop &optional lim) 1384 "Find next place where property PROP is non-nil, up to LIM. 1385 Return a cons of (POS . PROPERTY) where POS is point if point 1386 contains non-nil PROP." 1387 (let ((res 1388 (if (get-text-property (point) prop) (point) 1389 (next-single-property-change 1390 (point) prop nil (or lim (point-max)))))) 1391 (when (and res (get-text-property res prop)) (cons res prop)))) 1392 1393 (defun markdown-min-of-seq (map-fn seq) 1394 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." 1395 (cl-loop for el in seq 1396 with min = 1.0e+INF ; infinity 1397 with min-el = nil 1398 do (let ((res (funcall map-fn el))) 1399 (when (< res min) 1400 (setq min res) 1401 (setq min-el el))) 1402 finally return min-el)) 1403 1404 (defun markdown-max-of-seq (map-fn seq) 1405 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." 1406 (cl-loop for el in seq 1407 with max = -1.0e+INF ; negative infinity 1408 with max-el = nil 1409 do (let ((res (funcall map-fn el))) 1410 (when (and res (> res max)) 1411 (setq max res) 1412 (setq max-el el))) 1413 finally return max-el)) 1414 1415 (defun markdown-find-previous-block () 1416 "Find previous block. 1417 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was 1418 unable to propertize the entire block, but was able to propertize the beginning 1419 of the block. If so, return a cons of (pos . property) where the beginning of 1420 the block was propertized." 1421 (let ((start-pt (point)) 1422 (closest-open 1423 (markdown-max-of-seq 1424 #'car 1425 (cl-remove-if 1426 #'null 1427 (cl-mapcar 1428 #'markdown-find-previous-prop 1429 (markdown-get-fenced-block-begin-properties)))))) 1430 (when closest-open 1431 (let* ((length-of-open-match 1432 (let ((match-d 1433 (get-text-property (car closest-open) (cdr closest-open)))) 1434 (- (cl-fourth match-d) (cl-third match-d)))) 1435 (end-regexp 1436 (markdown-maybe-funcall-regexp 1437 (cl-caadr 1438 (cl-find-if 1439 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) 1440 markdown-fenced-block-pairs)) 1441 length-of-open-match)) 1442 (end-prop-loc 1443 (save-excursion 1444 (save-match-data 1445 (goto-char (car closest-open)) 1446 (and (re-search-forward end-regexp start-pt t) 1447 (match-beginning 0)))))) 1448 (and (not end-prop-loc) closest-open))))) 1449 1450 (defun markdown-get-fenced-block-from-start (prop) 1451 "Return limits of an enclosing fenced block from its start, using PROP. 1452 Return value is a list usable as `match-data'." 1453 (catch 'no-rest-of-block 1454 (let* ((correct-entry 1455 (cl-find-if 1456 (lambda (entry) (eq (cl-cadar entry) prop)) 1457 markdown-fenced-block-pairs)) 1458 (begin-of-begin (cl-first (markdown-text-property-at-point prop))) 1459 (middle-prop (cl-third correct-entry)) 1460 (end-prop (cl-cadadr correct-entry)) 1461 (end-of-end 1462 (save-excursion 1463 (goto-char (match-end 0)) ; end of begin 1464 (unless (eobp) (forward-char)) 1465 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1466 (if (not mid-prop-v) ; no middle 1467 (progn 1468 ;; try to find end by advancing one 1469 (let ((end-prop-v 1470 (markdown-text-property-at-point end-prop))) 1471 (if end-prop-v (cl-second end-prop-v) 1472 (throw 'no-rest-of-block nil)))) 1473 (set-match-data mid-prop-v) 1474 (goto-char (match-end 0)) ; end of middle 1475 (beginning-of-line) ; into end 1476 (cl-second (markdown-text-property-at-point end-prop))))))) 1477 (list begin-of-begin end-of-end)))) 1478 1479 (defun markdown-get-fenced-block-from-middle (prop) 1480 "Return limits of an enclosing fenced block from its middle, using PROP. 1481 Return value is a list usable as `match-data'." 1482 (let* ((correct-entry 1483 (cl-find-if 1484 (lambda (entry) (eq (cl-third entry) prop)) 1485 markdown-fenced-block-pairs)) 1486 (begin-prop (cl-cadar correct-entry)) 1487 (begin-of-begin 1488 (save-excursion 1489 (goto-char (match-beginning 0)) 1490 (unless (bobp) (forward-line -1)) 1491 (beginning-of-line) 1492 (cl-first (markdown-text-property-at-point begin-prop)))) 1493 (end-prop (cl-cadadr correct-entry)) 1494 (end-of-end 1495 (save-excursion 1496 (goto-char (match-end 0)) 1497 (beginning-of-line) 1498 (cl-second (markdown-text-property-at-point end-prop))))) 1499 (list begin-of-begin end-of-end))) 1500 1501 (defun markdown-get-fenced-block-from-end (prop) 1502 "Return limits of an enclosing fenced block from its end, using PROP. 1503 Return value is a list usable as `match-data'." 1504 (let* ((correct-entry 1505 (cl-find-if 1506 (lambda (entry) (eq (cl-cadadr entry) prop)) 1507 markdown-fenced-block-pairs)) 1508 (end-of-end (cl-second (markdown-text-property-at-point prop))) 1509 (middle-prop (cl-third correct-entry)) 1510 (begin-prop (cl-cadar correct-entry)) 1511 (begin-of-begin 1512 (save-excursion 1513 (goto-char (match-beginning 0)) ; beginning of end 1514 (unless (bobp) (backward-char)) ; into middle 1515 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1516 (if (not mid-prop-v) 1517 (progn 1518 (beginning-of-line) 1519 (cl-first (markdown-text-property-at-point begin-prop))) 1520 (set-match-data mid-prop-v) 1521 (goto-char (match-beginning 0)) ; beginning of middle 1522 (unless (bobp) (forward-line -1)) ; into beginning 1523 (beginning-of-line) 1524 (cl-first (markdown-text-property-at-point begin-prop))))))) 1525 (list begin-of-begin end-of-end))) 1526 1527 (defun markdown-get-enclosing-fenced-block-construct (&optional pos) 1528 "Get \"fake\" match data for block enclosing POS. 1529 Returns fake match data which encloses the start, middle, and end 1530 of the block construct enclosing POS, if it exists. Used in 1531 `markdown-code-block-at-pos'." 1532 (save-excursion 1533 (when pos (goto-char pos)) 1534 (beginning-of-line) 1535 (car 1536 (cl-remove-if 1537 #'null 1538 (cl-mapcar 1539 (lambda (fun-and-prop) 1540 (cl-destructuring-bind (fun prop) fun-and-prop 1541 (when prop 1542 (save-match-data 1543 (set-match-data (markdown-text-property-at-point prop)) 1544 (funcall fun prop))))) 1545 `((markdown-get-fenced-block-from-start 1546 ,(cl-find-if 1547 #'markdown-text-property-at-point 1548 (markdown-get-fenced-block-begin-properties))) 1549 (markdown-get-fenced-block-from-middle 1550 ,(cl-find-if 1551 #'markdown-text-property-at-point 1552 (markdown-get-fenced-block-middle-properties))) 1553 (markdown-get-fenced-block-from-end 1554 ,(cl-find-if 1555 #'markdown-text-property-at-point 1556 (markdown-get-fenced-block-end-properties))))))))) 1557 1558 (defun markdown-propertize-end-match (reg end fence-spec middle-begin) 1559 "Get match for REG up to END, if exists, and propertize appropriately. 1560 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and 1561 MIDDLE-BEGIN is the start of the \"middle\" section of the block." 1562 (when (re-search-forward reg end t) 1563 (let ((close-begin (match-beginning 0)) ; Start of closing line. 1564 (close-end (match-end 0)) ; End of closing line. 1565 (close-data (match-data t))) ; Match data for closing line. 1566 ;; Propertize middle section of fenced block. 1567 (put-text-property middle-begin close-begin 1568 (cl-third fence-spec) 1569 (list middle-begin close-begin)) 1570 ;; If the block is a YAML block, propertize the declarations inside 1571 (when (< middle-begin close-begin) ;; workaround #634 1572 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) 1573 ;; Propertize closing line of fenced block. 1574 (put-text-property close-begin close-end 1575 (cl-cadadr fence-spec) close-data)))) 1576 1577 (defun markdown--triple-quote-single-line-p (begin) 1578 (save-excursion 1579 (goto-char begin) 1580 (save-match-data 1581 (and (search-forward "```" nil t) 1582 (search-forward "```" (line-end-position) t))))) 1583 1584 (defun markdown-syntax-propertize-fenced-block-constructs (start end) 1585 "Propertize according to `markdown-fenced-block-pairs' from START to END. 1586 If unable to propertize an entire block (if the start of a block is within START 1587 and END, but the end of the block is not), propertize the start section of a 1588 block, then in a subsequent call propertize both middle and end by finding the 1589 start which was previously propertized." 1590 (let ((start-reg (markdown-get-start-fence-regexp))) 1591 (save-excursion 1592 (goto-char start) 1593 ;; start from previous unclosed block, if exists 1594 (let ((prev-begin-block (markdown-find-previous-block))) 1595 (when prev-begin-block 1596 (let* ((correct-entry 1597 (cl-find-if (lambda (entry) 1598 (eq (cdr prev-begin-block) (cl-cadar entry))) 1599 markdown-fenced-block-pairs)) 1600 (enclosed-text-start (1+ (car prev-begin-block))) 1601 (start-length 1602 (save-excursion 1603 (goto-char (car prev-begin-block)) 1604 (string-match 1605 (markdown-maybe-funcall-regexp 1606 (caar correct-entry)) 1607 (buffer-substring 1608 (point-at-bol) (point-at-eol))) 1609 (- (match-end 1) (match-beginning 1)))) 1610 (end-reg (markdown-maybe-funcall-regexp 1611 (cl-caadr correct-entry) start-length))) 1612 (markdown-propertize-end-match 1613 end-reg end correct-entry enclosed-text-start)))) 1614 ;; find all new blocks within region 1615 (while (re-search-forward start-reg end t) 1616 ;; we assume the opening constructs take up (only) an entire line, 1617 ;; so we re-check the current line 1618 (let* ((block-start (match-beginning 0)) 1619 (cur-line (buffer-substring (point-at-bol) (point-at-eol))) 1620 ;; find entry in `markdown-fenced-block-pairs' corresponding 1621 ;; to regex which was matched 1622 (correct-entry 1623 (cl-find-if 1624 (lambda (fenced-pair) 1625 (string-match-p 1626 (markdown-maybe-funcall-regexp (caar fenced-pair)) 1627 cur-line)) 1628 markdown-fenced-block-pairs)) 1629 (enclosed-text-start 1630 (save-excursion (1+ (point-at-eol)))) 1631 (end-reg 1632 (markdown-maybe-funcall-regexp 1633 (cl-caadr correct-entry) 1634 (if (and (match-beginning 1) (match-end 1)) 1635 (- (match-end 1) (match-beginning 1)) 1636 0))) 1637 (prop (cl-cadar correct-entry))) 1638 (when (or (not (eq prop 'markdown-gfm-block-begin)) 1639 (not (markdown--triple-quote-single-line-p block-start))) 1640 ;; get correct match data 1641 (save-excursion 1642 (beginning-of-line) 1643 (re-search-forward 1644 (markdown-maybe-funcall-regexp (caar correct-entry)) 1645 (point-at-eol))) 1646 ;; mark starting, even if ending is outside of region 1647 (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) 1648 (markdown-propertize-end-match 1649 end-reg end correct-entry enclosed-text-start))))))) 1650 1651 (defun markdown-syntax-propertize-blockquotes (start end) 1652 "Match blockquotes from START to END." 1653 (save-excursion 1654 (goto-char start) 1655 (while (and (re-search-forward markdown-regex-blockquote end t) 1656 (not (markdown-code-block-at-pos (match-beginning 0)))) 1657 (put-text-property (match-beginning 0) (match-end 0) 1658 'markdown-blockquote 1659 (match-data t))))) 1660 1661 (defun markdown-syntax-propertize-hrs (start end) 1662 "Match horizontal rules from START to END." 1663 (save-excursion 1664 (goto-char start) 1665 (while (re-search-forward markdown-regex-hr end t) 1666 (let ((beg (match-beginning 0)) 1667 (end (match-end 0))) 1668 (goto-char beg) 1669 (unless (or (markdown-on-heading-p) 1670 (markdown-code-block-at-point-p)) 1671 (put-text-property beg end 'markdown-hr (match-data t))) 1672 (goto-char end))))) 1673 1674 (defun markdown-syntax-propertize-yaml-metadata (start end) 1675 "Propertize elements inside YAML metadata blocks from START to END. 1676 Assumes region from START and END is already known to be the interior 1677 region of a YAML metadata block as propertized by 1678 `markdown-syntax-propertize-fenced-block-constructs'." 1679 (save-excursion 1680 (goto-char start) 1681 (cl-loop 1682 while (re-search-forward markdown-regex-declarative-metadata end t) 1683 do (progn 1684 (put-text-property (match-beginning 1) (match-end 1) 1685 'markdown-metadata-key (match-data t)) 1686 (put-text-property (match-beginning 2) (match-end 2) 1687 'markdown-metadata-markup (match-data t)) 1688 (put-text-property (match-beginning 3) (match-end 3) 1689 'markdown-metadata-value (match-data t)))))) 1690 1691 (defun markdown-syntax-propertize-headings (start end) 1692 "Match headings of type SYMBOL with REGEX from START to END." 1693 (goto-char start) 1694 (while (re-search-forward markdown-regex-header end t) 1695 (unless (markdown-code-block-at-pos (match-beginning 0)) 1696 (put-text-property 1697 (match-beginning 0) (match-end 0) 'markdown-heading 1698 (match-data t)) 1699 (put-text-property 1700 (match-beginning 0) (match-end 0) 1701 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) 1702 ((match-string-no-properties 3) 'markdown-heading-2-setext) 1703 (t (let ((atx-level (length (markdown-trim-whitespace 1704 (match-string-no-properties 4))))) 1705 (intern (format "markdown-heading-%d-atx" atx-level))))) 1706 (match-data t))))) 1707 1708 (defun markdown-syntax-propertize-comments (start end) 1709 "Match HTML comments from the START to END." 1710 ;; Implement by loop instead of recursive call for avoiding 1711 ;; exceed max-lisp-eval-depth issue 1712 ;; https://github.com/jrblevin/markdown-mode/issues/536 1713 (let (finish) 1714 (goto-char start) 1715 (while (not finish) 1716 (let* ((in-comment (nth 4 (syntax-ppss))) 1717 (comment-begin (nth 8 (syntax-ppss)))) 1718 (cond 1719 ;; Comment start 1720 ((and (not in-comment) 1721 (re-search-forward markdown-regex-comment-start end t) 1722 (not (markdown-inline-code-at-point-p)) 1723 (not (markdown-code-block-at-point-p))) 1724 (let ((open-beg (match-beginning 0))) 1725 (put-text-property open-beg (1+ open-beg) 1726 'syntax-table (string-to-syntax "<")) 1727 (goto-char (min (1+ (match-end 0)) end (point-max))))) 1728 ;; Comment end 1729 ((and in-comment comment-begin 1730 (re-search-forward markdown-regex-comment-end end t)) 1731 (let ((comment-end (match-end 0))) 1732 (put-text-property (1- comment-end) comment-end 1733 'syntax-table (string-to-syntax ">")) 1734 ;; Remove any other text properties inside the comment 1735 (remove-text-properties comment-begin comment-end 1736 markdown--syntax-properties) 1737 (put-text-property comment-begin comment-end 1738 'markdown-comment (list comment-begin comment-end)) 1739 (goto-char (min comment-end end (point-max))))) 1740 ;; Nothing found 1741 (t (setq finish t))))) 1742 nil)) 1743 1744 (defun markdown-syntax-propertize (start end) 1745 "Function used as `syntax-propertize-function'. 1746 START and END delimit region to propertize." 1747 (with-silent-modifications 1748 (save-excursion 1749 (remove-text-properties start end markdown--syntax-properties) 1750 (markdown-syntax-propertize-fenced-block-constructs start end) 1751 (markdown-syntax-propertize-list-items start end) 1752 (markdown-syntax-propertize-pre-blocks start end) 1753 (markdown-syntax-propertize-blockquotes start end) 1754 (markdown-syntax-propertize-headings start end) 1755 (markdown-syntax-propertize-hrs start end) 1756 (markdown-syntax-propertize-comments start end)))) 1757 1758 1759 ;;; Markup Hiding ============================================================= 1760 1761 (defconst markdown-markup-properties 1762 '(face markdown-markup-face invisible markdown-markup) 1763 "List of properties and values to apply to markup.") 1764 1765 (defconst markdown-language-keyword-properties 1766 '(face markdown-language-keyword-face invisible markdown-markup) 1767 "List of properties and values to apply to code block language names.") 1768 1769 (defconst markdown-language-info-properties 1770 '(face markdown-language-info-face invisible markdown-markup) 1771 "List of properties and values to apply to code block language info strings.") 1772 1773 (defconst markdown-include-title-properties 1774 '(face markdown-link-title-face invisible markdown-markup) 1775 "List of properties and values to apply to included code titles.") 1776 1777 (defcustom markdown-hide-markup nil 1778 "Determines whether markup in the buffer will be hidden. 1779 When set to nil, all markup is displayed in the buffer as it 1780 appears in the file. An exception is when `markdown-hide-urls' 1781 is non-nil. 1782 Set this to a non-nil value to turn this feature on by default. 1783 You can interactively toggle the value of this variable with 1784 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], 1785 or from the Markdown > Show & Hide menu. 1786 1787 Markup hiding works by adding text properties to positions in the 1788 buffer---either the `invisible' property or the `display' property 1789 in cases where alternative glyphs are used (e.g., list bullets). 1790 This does not, however, affect printing or other output. 1791 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will 1792 not honor these text properties. For printing, it would be better 1793 to first convert to HTML or PDF (e.g,. using Pandoc)." 1794 :group 'markdown 1795 :type 'boolean 1796 :safe 'booleanp 1797 :package-version '(markdown-mode . "2.3")) 1798 (make-variable-buffer-local 'markdown-hide-markup) 1799 1800 (defun markdown-toggle-markup-hiding (&optional arg) 1801 "Toggle the display or hiding of markup. 1802 With a prefix argument ARG, enable markup hiding if ARG is positive, 1803 and disable it otherwise. 1804 See `markdown-hide-markup' for additional details." 1805 (interactive (list (or current-prefix-arg 'toggle))) 1806 (setq markdown-hide-markup 1807 (if (eq arg 'toggle) 1808 (not markdown-hide-markup) 1809 (> (prefix-numeric-value arg) 0))) 1810 (if markdown-hide-markup 1811 (progn (add-to-invisibility-spec 'markdown-markup) 1812 (message "markdown-mode markup hiding enabled")) 1813 (progn (remove-from-invisibility-spec 'markdown-markup) 1814 (message "markdown-mode markup hiding disabled"))) 1815 (markdown-reload-extensions)) 1816 1817 1818 ;;; Font Lock ================================================================= 1819 1820 (require 'font-lock) 1821 1822 (defgroup markdown-faces nil 1823 "Faces used in Markdown Mode." 1824 :group 'markdown 1825 :group 'faces) 1826 1827 (defface markdown-italic-face 1828 '((t (:inherit italic))) 1829 "Face for italic text." 1830 :group 'markdown-faces) 1831 1832 (defface markdown-bold-face 1833 '((t (:inherit bold))) 1834 "Face for bold text." 1835 :group 'markdown-faces) 1836 1837 (defface markdown-strike-through-face 1838 '((t (:strike-through t))) 1839 "Face for strike-through text." 1840 :group 'markdown-faces) 1841 1842 (defface markdown-markup-face 1843 '((t (:inherit shadow :slant normal :weight normal))) 1844 "Face for markup elements." 1845 :group 'markdown-faces) 1846 1847 (defface markdown-header-rule-face 1848 '((t (:inherit markdown-markup-face))) 1849 "Base face for headers rules." 1850 :group 'markdown-faces) 1851 1852 (defface markdown-header-delimiter-face 1853 '((t (:inherit markdown-markup-face))) 1854 "Base face for headers hash delimiter." 1855 :group 'markdown-faces) 1856 1857 (defface markdown-list-face 1858 '((t (:inherit markdown-markup-face))) 1859 "Face for list item markers." 1860 :group 'markdown-faces) 1861 1862 (defface markdown-blockquote-face 1863 '((t (:inherit font-lock-doc-face))) 1864 "Face for blockquote sections." 1865 :group 'markdown-faces) 1866 1867 (defface markdown-code-face 1868 '((t (:inherit fixed-pitch))) 1869 "Face for inline code, pre blocks, and fenced code blocks. 1870 This may be used, for example, to add a contrasting background to 1871 inline code fragments and code blocks." 1872 :group 'markdown-faces) 1873 1874 (defface markdown-inline-code-face 1875 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1876 "Face for inline code." 1877 :group 'markdown-faces) 1878 1879 (defface markdown-pre-face 1880 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1881 "Face for preformatted text." 1882 :group 'markdown-faces) 1883 1884 (defface markdown-table-face 1885 '((t (:inherit (markdown-code-face)))) 1886 "Face for tables." 1887 :group 'markdown-faces) 1888 1889 (defface markdown-language-keyword-face 1890 '((t (:inherit font-lock-type-face))) 1891 "Face for programming language identifiers." 1892 :group 'markdown-faces) 1893 1894 (defface markdown-language-info-face 1895 '((t (:inherit font-lock-string-face))) 1896 "Face for programming language info strings." 1897 :group 'markdown-faces) 1898 1899 (defface markdown-link-face 1900 '((t (:inherit link))) 1901 "Face for links." 1902 :group 'markdown-faces) 1903 1904 (defface markdown-missing-link-face 1905 '((t (:inherit font-lock-warning-face))) 1906 "Face for missing links." 1907 :group 'markdown-faces) 1908 1909 (defface markdown-reference-face 1910 '((t (:inherit markdown-markup-face))) 1911 "Face for link references." 1912 :group 'markdown-faces) 1913 1914 (defface markdown-footnote-marker-face 1915 '((t (:inherit markdown-markup-face))) 1916 "Face for footnote markers." 1917 :group 'markdown-faces) 1918 1919 (defface markdown-footnote-text-face 1920 '((t (:inherit font-lock-comment-face))) 1921 "Face for footnote text." 1922 :group 'markdown-faces) 1923 1924 (defface markdown-url-face 1925 '((t (:inherit font-lock-string-face))) 1926 "Face for URLs that are part of markup. 1927 For example, this applies to URLs in inline links: 1928 [link text](http://example.com/)." 1929 :group 'markdown-faces) 1930 1931 (defface markdown-plain-url-face 1932 '((t (:inherit markdown-link-face))) 1933 "Face for URLs that are also links. 1934 For example, this applies to plain angle bracket URLs: 1935 <http://example.com/>." 1936 :group 'markdown-faces) 1937 1938 (defface markdown-link-title-face 1939 '((t (:inherit font-lock-comment-face))) 1940 "Face for reference link titles." 1941 :group 'markdown-faces) 1942 1943 (defface markdown-line-break-face 1944 '((t (:inherit font-lock-constant-face :underline t))) 1945 "Face for hard line breaks." 1946 :group 'markdown-faces) 1947 1948 (defface markdown-comment-face 1949 '((t (:inherit font-lock-comment-face))) 1950 "Face for HTML comments." 1951 :group 'markdown-faces) 1952 1953 (defface markdown-math-face 1954 '((t (:inherit font-lock-string-face))) 1955 "Face for LaTeX expressions." 1956 :group 'markdown-faces) 1957 1958 (defface markdown-metadata-key-face 1959 '((t (:inherit font-lock-variable-name-face))) 1960 "Face for metadata keys." 1961 :group 'markdown-faces) 1962 1963 (defface markdown-metadata-value-face 1964 '((t (:inherit font-lock-string-face))) 1965 "Face for metadata values." 1966 :group 'markdown-faces) 1967 1968 (defface markdown-gfm-checkbox-face 1969 '((t (:inherit font-lock-builtin-face))) 1970 "Face for GFM checkboxes." 1971 :group 'markdown-faces) 1972 1973 (defface markdown-highlight-face 1974 '((t (:inherit highlight))) 1975 "Face for mouse highlighting." 1976 :group 'markdown-faces) 1977 1978 (defface markdown-hr-face 1979 '((t (:inherit markdown-markup-face))) 1980 "Face for horizontal rules." 1981 :group 'markdown-faces) 1982 1983 (defface markdown-html-tag-name-face 1984 '((t (:inherit font-lock-type-face))) 1985 "Face for HTML tag names." 1986 :group 'markdown-faces) 1987 1988 (defface markdown-html-tag-delimiter-face 1989 '((t (:inherit markdown-markup-face))) 1990 "Face for HTML tag delimiters." 1991 :group 'markdown-faces) 1992 1993 (defface markdown-html-attr-name-face 1994 '((t (:inherit font-lock-variable-name-face))) 1995 "Face for HTML attribute names." 1996 :group 'markdown-faces) 1997 1998 (defface markdown-html-attr-value-face 1999 '((t (:inherit font-lock-string-face))) 2000 "Face for HTML attribute values." 2001 :group 'markdown-faces) 2002 2003 (defface markdown-html-entity-face 2004 '((t (:inherit font-lock-variable-name-face))) 2005 "Face for HTML entities." 2006 :group 'markdown-faces) 2007 2008 (defface markdown-highlighting-face 2009 '((t (:background "yellow" :foreground "black"))) 2010 "Face for highlighting." 2011 :group 'markdown-faces) 2012 2013 (defcustom markdown-header-scaling nil 2014 "Whether to use variable-height faces for headers. 2015 When non-nil, `markdown-header-face' will inherit from 2016 `variable-pitch' and the scaling values in 2017 `markdown-header-scaling-values' will be applied to 2018 headers of levels one through six respectively." 2019 :type 'boolean 2020 :initialize #'custom-initialize-default 2021 :set (lambda (symbol value) 2022 (set-default symbol value) 2023 (markdown-update-header-faces value)) 2024 :group 'markdown-faces 2025 :package-version '(markdown-mode . "2.2")) 2026 2027 (defcustom markdown-header-scaling-values 2028 '(2.0 1.7 1.4 1.1 1.0 1.0) 2029 "List of scaling values for headers of level one through six. 2030 Used when `markdown-header-scaling' is non-nil." 2031 :type 'list 2032 :initialize #'custom-initialize-default 2033 :set (lambda (symbol value) 2034 (set-default symbol value) 2035 (markdown-update-header-faces markdown-header-scaling value))) 2036 2037 (defmacro markdown--dotimes-when-compile (i-n body) 2038 (declare (indent 1) (debug ((symbolp form) form))) 2039 (let ((var (car i-n)) 2040 (n (cadr i-n)) 2041 (code ())) 2042 (dotimes (i (eval n t)) 2043 (push (eval body `((,var . ,i))) code)) 2044 `(progn ,@(nreverse code)))) 2045 2046 (defface markdown-header-face 2047 `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) 2048 font-lock-function-name-face) 2049 :weight bold))) 2050 "Base face for headers.") 2051 2052 (markdown--dotimes-when-compile (num 6) 2053 (let* ((num1 (1+ num)) 2054 (face-name (intern (format "markdown-header-face-%s" num1)))) 2055 `(defface ,face-name 2056 (,'\` ((t (:inherit markdown-header-face 2057 :height 2058 (,'\, (if markdown-header-scaling 2059 (float (nth ,num markdown-header-scaling-values)) 2060 1.0)))))) 2061 (format "Face for level %s headers. 2062 You probably don't want to customize this face directly. Instead 2063 you can customize the base face `markdown-header-face' or the 2064 variable-height variable `markdown-header-scaling'." ,num1)))) 2065 2066 (defun markdown-update-header-faces (&optional scaling scaling-values) 2067 "Update header faces, depending on if header SCALING is desired. 2068 If so, use given list of SCALING-VALUES relative to the baseline 2069 size of `markdown-header-face'." 2070 (dotimes (num 6) 2071 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) 2072 (scale (cond ((not scaling) 1.0) 2073 (scaling-values (float (nth num scaling-values))) 2074 (t (float (nth num markdown-header-scaling-values)))))) 2075 (unless (get face-name 'saved-face) ; Don't update customized faces 2076 (set-face-attribute face-name nil :height scale))))) 2077 2078 (defun markdown-syntactic-face (state) 2079 "Return font-lock face for characters with given STATE. 2080 See `font-lock-syntactic-face-function' for details." 2081 (let ((in-comment (nth 4 state))) 2082 (cond 2083 (in-comment 'markdown-comment-face) 2084 (t nil)))) 2085 2086 (defcustom markdown-list-item-bullets 2087 '("●" "◎" "○" "◆" "◇" "►" "•") 2088 "List of bullets to use for unordered lists. 2089 It can contain any number of symbols, which will be repeated. 2090 Depending on your font, some reasonable choices are: 2091 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." 2092 :group 'markdown 2093 :type '(repeat (string :tag "Bullet character")) 2094 :package-version '(markdown-mode . "2.3")) 2095 2096 (defun markdown--footnote-marker-properties () 2097 "Return a font-lock facespec expression for footnote marker text." 2098 `(face markdown-footnote-marker-face 2099 ,@(when markdown-hide-markup 2100 `(display ,markdown-footnote-display)))) 2101 2102 (defun markdown--pandoc-inline-footnote-properties () 2103 "Return a font-lock facespec expression for Pandoc inline footnote text." 2104 `(face markdown-footnote-text-face 2105 ,@(when markdown-hide-markup 2106 `(display ,markdown-footnote-display)))) 2107 2108 (defvar markdown-mode-font-lock-keywords 2109 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) 2110 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) 2111 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) 2112 (2 'markdown-markup-face) 2113 (3 'markdown-metadata-value-face))) 2114 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) 2115 (2 markdown-markup-properties nil t) 2116 (3 markdown-language-keyword-properties nil t) 2117 (4 markdown-language-info-properties nil t) 2118 (5 markdown-markup-properties nil t))) 2119 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) 2120 (markdown-fontify-gfm-code-blocks) 2121 (markdown-fontify-tables) 2122 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) 2123 (2 markdown-markup-properties nil t) 2124 (3 markdown-language-keyword-properties nil t) 2125 (4 markdown-language-info-properties nil t) 2126 (5 markdown-markup-properties nil t))) 2127 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) 2128 (markdown-fontify-fenced-code-blocks) 2129 (markdown-match-pre-blocks . ((0 'markdown-pre-face))) 2130 (markdown-fontify-headings) 2131 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) 2132 (2 'markdown-markup-face) 2133 (3 'markdown-metadata-value-face))) 2134 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) 2135 (2 'markdown-markup-face) 2136 (3 'markdown-metadata-value-face))) 2137 (markdown-fontify-hrs) 2138 (markdown-match-code . ((1 markdown-markup-properties prepend) 2139 (2 'markdown-inline-code-face prepend) 2140 (3 markdown-markup-properties prepend))) 2141 (,markdown-regex-kbd . ((1 markdown-markup-properties) 2142 (2 'markdown-inline-code-face) 2143 (3 markdown-markup-properties))) 2144 (markdown-fontify-angle-uris) 2145 (,markdown-regex-email . 'markdown-plain-url-face) 2146 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) 2147 (2 'markdown-html-tag-name-face t) 2148 (3 'markdown-html-tag-delimiter-face t) 2149 ;; Anchored matcher for HTML tag attributes 2150 (,markdown-regex-html-attr 2151 ;; Before searching, move past tag 2152 ;; name; set limit at tag close. 2153 (progn 2154 (goto-char (match-end 2)) (match-end 3)) 2155 nil 2156 . ((1 'markdown-html-attr-name-face) 2157 (3 'markdown-html-tag-delimiter-face nil t) 2158 (4 'markdown-html-attr-value-face nil t))))) 2159 (,markdown-regex-html-entity . 'markdown-html-entity-face) 2160 (markdown-fontify-list-items) 2161 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ 2162 (2 (markdown--footnote-marker-properties)) ; label 2163 (3 markdown-markup-properties))) ; ] 2164 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ 2165 (2 markdown-markup-properties) ; [ 2166 (3 (markdown--pandoc-inline-footnote-properties)) ; text 2167 (4 markdown-markup-properties))) ; ] 2168 (markdown-match-includes . ((1 markdown-markup-properties) 2169 (2 markdown-markup-properties nil t) 2170 (3 markdown-include-title-properties nil t) 2171 (4 markdown-markup-properties nil t) 2172 (5 markdown-markup-properties) 2173 (6 'markdown-url-face) 2174 (7 markdown-markup-properties))) 2175 (markdown-fontify-inline-links) 2176 (markdown-fontify-reference-links) 2177 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ 2178 (2 'markdown-reference-face) ; label 2179 (3 'markdown-markup-face) ; ] 2180 (4 'markdown-markup-face) ; : 2181 (5 'markdown-url-face) ; url 2182 (6 'markdown-link-title-face))) ; "title" (optional) 2183 (markdown-fontify-plain-uris) 2184 ;; Math mode $..$ 2185 (markdown-match-math-single . ((1 'markdown-markup-face prepend) 2186 (2 'markdown-math-face append) 2187 (3 'markdown-markup-face prepend))) 2188 ;; Math mode $$..$$ 2189 (markdown-match-math-double . ((1 'markdown-markup-face prepend) 2190 (2 'markdown-math-face append) 2191 (3 'markdown-markup-face prepend))) 2192 ;; Math mode \[..\] and \\[..\\] 2193 (markdown-match-math-display . ((1 'markdown-markup-face prepend) 2194 (3 'markdown-math-face append) 2195 (4 'markdown-markup-face prepend))) 2196 (markdown-match-bold . ((1 markdown-markup-properties prepend) 2197 (2 'markdown-bold-face append) 2198 (3 markdown-markup-properties prepend))) 2199 (markdown-match-italic . ((1 markdown-markup-properties prepend) 2200 (2 'markdown-italic-face append) 2201 (3 markdown-markup-properties prepend))) 2202 (,markdown-regex-strike-through . ((3 markdown-markup-properties) 2203 (4 'markdown-strike-through-face) 2204 (5 markdown-markup-properties))) 2205 (markdown--match-highlighting . ((3 markdown-markup-properties) 2206 (4 'markdown-highlighting-face) 2207 (5 markdown-markup-properties))) 2208 (,markdown-regex-line-break . (1 'markdown-line-break-face prepend)) 2209 (markdown-fontify-sub-superscripts) 2210 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) 2211 (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) 2212 (markdown-fontify-blockquotes) 2213 (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) 2214 "Syntax highlighting for Markdown files.") 2215 2216 ;; Footnotes 2217 (defvar-local markdown-footnote-counter 0 2218 "Counter for footnote numbers.") 2219 2220 (defconst markdown-footnote-chars 2221 "[[:alnum:]-]" 2222 "Regular expression matching any character for a footnote identifier.") 2223 2224 (defconst markdown-regex-footnote-definition 2225 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") 2226 "Regular expression matching a footnote definition, capturing the label.") 2227 2228 2229 ;;; Compatibility ============================================================= 2230 2231 (defun markdown-flyspell-check-word-p () 2232 "Return t if `flyspell' should check word just before point. 2233 Used for `flyspell-generic-check-word-predicate'." 2234 (save-excursion 2235 (goto-char (1- (point))) 2236 ;; https://github.com/jrblevin/markdown-mode/issues/560 2237 ;; enable spell check YAML meta data 2238 (if (or (and (markdown-code-block-at-point-p) 2239 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) 2240 (markdown-inline-code-at-point-p) 2241 (markdown-in-comment-p) 2242 (markdown--face-p (point) '(markdown-reference-face 2243 markdown-markup-face 2244 markdown-plain-url-face 2245 markdown-inline-code-face 2246 markdown-url-face))) 2247 (prog1 nil 2248 ;; If flyspell overlay is put, then remove it 2249 (let ((bounds (bounds-of-thing-at-point 'word))) 2250 (when bounds 2251 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) 2252 when (overlay-get ov 'flyspell-overlay) 2253 do 2254 (delete-overlay ov))))) 2255 t))) 2256 2257 2258 ;;; Markdown Parsing Functions ================================================ 2259 2260 (defun markdown-cur-line-blank-p () 2261 "Return t if the current line is blank and nil otherwise." 2262 (save-excursion 2263 (beginning-of-line) 2264 (looking-at-p markdown-regex-blank-line))) 2265 2266 (defun markdown-prev-line-blank () 2267 "Return t if the previous line is blank and nil otherwise. 2268 If we are at the first line, then consider the previous line to be blank." 2269 (or (= (line-beginning-position) (point-min)) 2270 (save-excursion 2271 (forward-line -1) 2272 (looking-at markdown-regex-blank-line)))) 2273 2274 (defun markdown-prev-line-blank-p () 2275 "Like `markdown-prev-line-blank', but preserve `match-data'." 2276 (save-match-data (markdown-prev-line-blank))) 2277 2278 (defun markdown-next-line-blank-p () 2279 "Return t if the next line is blank and nil otherwise. 2280 If we are at the last line, then consider the next line to be blank." 2281 (or (= (line-end-position) (point-max)) 2282 (save-excursion 2283 (forward-line 1) 2284 (markdown-cur-line-blank-p)))) 2285 2286 (defun markdown-prev-line-indent () 2287 "Return the number of leading whitespace characters in the previous line. 2288 Return 0 if the current line is the first line in the buffer." 2289 (save-excursion 2290 (if (= (line-beginning-position) (point-min)) 2291 0 2292 (forward-line -1) 2293 (current-indentation)))) 2294 2295 (defun markdown-next-line-indent () 2296 "Return the number of leading whitespace characters in the next line. 2297 Return 0 if line is the last line in the buffer." 2298 (save-excursion 2299 (if (= (line-end-position) (point-max)) 2300 0 2301 (forward-line 1) 2302 (current-indentation)))) 2303 2304 (defun markdown-new-baseline () 2305 "Determine if the current line begins a new baseline level. 2306 Assume point is positioned at beginning of line." 2307 (or (looking-at markdown-regex-header) 2308 (looking-at markdown-regex-hr) 2309 (and (= (current-indentation) 0) 2310 (not (looking-at markdown-regex-list)) 2311 (markdown-prev-line-blank)))) 2312 2313 (defun markdown-search-backward-baseline () 2314 "Search backward baseline point with no indentation and not a list item." 2315 (end-of-line) 2316 (let (stop) 2317 (while (not (or stop (bobp))) 2318 (re-search-backward markdown-regex-block-separator-noindent nil t) 2319 (when (match-end 2) 2320 (goto-char (match-end 2)) 2321 (cond 2322 ((markdown-new-baseline) 2323 (setq stop t)) 2324 ((looking-at-p markdown-regex-list) 2325 (setq stop nil)) 2326 (t (setq stop t))))))) 2327 2328 (defun markdown-update-list-levels (marker indent levels) 2329 "Update list levels given list MARKER, block INDENT, and current LEVELS. 2330 Here, MARKER is a string representing the type of list, INDENT is an integer 2331 giving the indentation, in spaces, of the current block, and LEVELS is a 2332 list of the indentation levels of parent list items. When LEVELS is nil, 2333 it means we are at baseline (not inside of a nested list)." 2334 (cond 2335 ;; New list item at baseline. 2336 ((and marker (null levels)) 2337 (setq levels (list indent))) 2338 ;; List item with greater indentation (four or more spaces). 2339 ;; Increase list level. 2340 ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) 2341 (setq levels (cons indent levels))) 2342 ;; List item with greater or equal indentation (less than four spaces). 2343 ;; Do not increase list level. 2344 ((and marker (>= indent (car levels))) 2345 levels) 2346 ;; Lesser indentation level. 2347 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser 2348 ;; indentation could move back more than one list level). Note 2349 ;; that this block need not be the beginning of list item. 2350 ((< indent (car levels)) 2351 (while (and (> (length levels) 1) 2352 (< indent (+ (cadr levels) markdown-list-indent-width))) 2353 (setq levels (cdr levels))) 2354 levels) 2355 ;; Otherwise, do nothing. 2356 (t levels))) 2357 2358 (defun markdown-calculate-list-levels () 2359 "Calculate list levels at point. 2360 Return a list of the form (n1 n2 n3 ...) where n1 is the 2361 indentation of the deepest nested list item in the branch of 2362 the list at the point, n2 is the indentation of the parent 2363 list item, and so on. The depth of the list item is therefore 2364 the length of the returned list. If the point is not at or 2365 immediately after a list item, return nil." 2366 (save-excursion 2367 (let ((first (point)) levels indent pre-regexp) 2368 ;; Find a baseline point with zero list indentation 2369 (markdown-search-backward-baseline) 2370 ;; Search for all list items between baseline and LOC 2371 (while (and (< (point) first) 2372 (re-search-forward markdown-regex-list first t)) 2373 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) 2374 (beginning-of-line) 2375 (cond 2376 ;; Make sure this is not a header or hr 2377 ((markdown-new-baseline) (setq levels nil)) 2378 ;; Make sure this is not a line from a pre block 2379 ((looking-at-p pre-regexp)) 2380 ;; If not, then update levels 2381 (t 2382 (setq indent (current-indentation)) 2383 (setq levels (markdown-update-list-levels (match-string 2) 2384 indent levels)))) 2385 (end-of-line)) 2386 levels))) 2387 2388 (defun markdown-prev-list-item (level) 2389 "Search backward from point for a list item with indentation LEVEL. 2390 Set point to the beginning of the item, and return point, or nil 2391 upon failure." 2392 (let (bounds indent prev) 2393 (setq prev (point)) 2394 (forward-line -1) 2395 (setq indent (current-indentation)) 2396 (while 2397 (cond 2398 ;; List item 2399 ((and (looking-at-p markdown-regex-list) 2400 (setq bounds (markdown-cur-list-item-bounds))) 2401 (cond 2402 ;; Stop and return point at item of equal indentation 2403 ((= (nth 3 bounds) level) 2404 (setq prev (point)) 2405 nil) 2406 ;; Stop and return nil at item with lesser indentation 2407 ((< (nth 3 bounds) level) 2408 (setq prev nil) 2409 nil) 2410 ;; Stop at beginning of buffer 2411 ((bobp) (setq prev nil)) 2412 ;; Continue at item with greater indentation 2413 ((> (nth 3 bounds) level) t))) 2414 ;; Stop at beginning of buffer 2415 ((bobp) (setq prev nil)) 2416 ;; Continue if current line is blank 2417 ((markdown-cur-line-blank-p) t) 2418 ;; Continue while indentation is the same or greater 2419 ((>= indent level) t) 2420 ;; Stop if current indentation is less than list item 2421 ;; and the next is blank 2422 ((and (< indent level) 2423 (markdown-next-line-blank-p)) 2424 (setq prev nil)) 2425 ;; Stop at a header 2426 ((looking-at-p markdown-regex-header) (setq prev nil)) 2427 ;; Stop at a horizontal rule 2428 ((looking-at-p markdown-regex-hr) (setq prev nil)) 2429 ;; Otherwise, continue. 2430 (t t)) 2431 (forward-line -1) 2432 (setq indent (current-indentation))) 2433 prev)) 2434 2435 (defun markdown-next-list-item (level) 2436 "Search forward from point for the next list item with indentation LEVEL. 2437 Set point to the beginning of the item, and return point, or nil 2438 upon failure." 2439 (let (bounds indent next) 2440 (setq next (point)) 2441 (if (looking-at markdown-regex-header-setext) 2442 (goto-char (match-end 0))) 2443 (forward-line) 2444 (setq indent (current-indentation)) 2445 (while 2446 (cond 2447 ;; Stop at end of the buffer. 2448 ((eobp) nil) 2449 ;; Continue if the current line is blank 2450 ((markdown-cur-line-blank-p) t) 2451 ;; List item 2452 ((and (looking-at-p markdown-regex-list) 2453 (setq bounds (markdown-cur-list-item-bounds))) 2454 (cond 2455 ;; Continue at item with greater indentation 2456 ((> (nth 3 bounds) level) t) 2457 ;; Stop and return point at item of equal indentation 2458 ((= (nth 3 bounds) level) 2459 (setq next (point)) 2460 nil) 2461 ;; Stop and return nil at item with lesser indentation 2462 ((< (nth 3 bounds) level) 2463 (setq next nil) 2464 nil))) 2465 ;; Continue while indentation is the same or greater 2466 ((>= indent level) t) 2467 ;; Stop if current indentation is less than list item 2468 ;; and the previous line was blank. 2469 ((and (< indent level) 2470 (markdown-prev-line-blank-p)) 2471 (setq next nil)) 2472 ;; Stop at a header 2473 ((looking-at-p markdown-regex-header) (setq next nil)) 2474 ;; Stop at a horizontal rule 2475 ((looking-at-p markdown-regex-hr) (setq next nil)) 2476 ;; Otherwise, continue. 2477 (t t)) 2478 (forward-line) 2479 (setq indent (current-indentation))) 2480 next)) 2481 2482 (defun markdown-cur-list-item-end (level) 2483 "Move to end of list item with pre-marker indentation LEVEL. 2484 Return the point at the end when a list item was found at the 2485 original point. If the point is not in a list item, do nothing." 2486 (let (indent) 2487 (forward-line) 2488 (setq indent (current-indentation)) 2489 (while 2490 (cond 2491 ;; Stop at end of the buffer. 2492 ((eobp) nil) 2493 ;; Continue while indentation is the same or greater 2494 ((>= indent level) t) 2495 ;; Continue if the current line is blank 2496 ((looking-at markdown-regex-blank-line) t) 2497 ;; Stop if current indentation is less than list item 2498 ;; and the previous line was blank. 2499 ((and (< indent level) 2500 (markdown-prev-line-blank)) 2501 nil) 2502 ;; Stop at a new list items of the same or lesser 2503 ;; indentation, headings, and horizontal rules. 2504 ((looking-at (concat "\\(?:" markdown-regex-list 2505 "\\|" markdown-regex-header 2506 "\\|" markdown-regex-hr "\\)")) 2507 nil) 2508 ;; Otherwise, continue. 2509 (t t)) 2510 (forward-line) 2511 (setq indent (current-indentation))) 2512 ;; Don't skip over whitespace for empty list items (marker and 2513 ;; whitespace only), just move to end of whitespace. 2514 (if (save-excursion 2515 (beginning-of-line) 2516 (looking-at (concat markdown-regex-list "[ \t]*$"))) 2517 (goto-char (match-end 3)) 2518 (skip-chars-backward " \t\n")) 2519 (end-of-line) 2520 (point))) 2521 2522 (defun markdown-cur-list-item-bounds () 2523 "Return bounds for list item at point. 2524 Return a list of the following form: 2525 2526 (begin end indent nonlist-indent marker checkbox match) 2527 2528 The named components are: 2529 2530 - begin: Position of beginning of list item, including leading indentation. 2531 - end: Position of the end of the list item, including list item text. 2532 - indent: Number of characters of indentation before list marker (an integer). 2533 - nonlist-indent: Number characters of indentation, list 2534 marker, and whitespace following list marker (an integer). 2535 - marker: String containing the list marker and following whitespace 2536 (e.g., \"- \" or \"* \"). 2537 - checkbox: String containing the GFM checkbox portion, if any, 2538 including any trailing whitespace before the text 2539 begins (e.g., \"[x] \"). 2540 - match: match data for markdown-regex-list 2541 2542 As an example, for the following unordered list item 2543 2544 - item 2545 2546 the returned list would be 2547 2548 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) 2549 2550 If the point is not inside a list item, return nil." 2551 (car (get-text-property (point-at-bol) 'markdown-list-item))) 2552 2553 (defun markdown-list-item-at-point-p () 2554 "Return t if there is a list item at the point and nil otherwise." 2555 (save-match-data (markdown-cur-list-item-bounds))) 2556 2557 (defun markdown-prev-list-item-bounds () 2558 "Return bounds of previous item in the same list of any level. 2559 The return value has the same form as that of 2560 `markdown-cur-list-item-bounds'." 2561 (save-excursion 2562 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2563 (beginning-of-list (save-excursion (markdown-beginning-of-list))) 2564 stop) 2565 (when cur-bounds 2566 (goto-char (nth 0 cur-bounds)) 2567 (while (and (not stop) (not (bobp)) 2568 (re-search-backward markdown-regex-list 2569 beginning-of-list t)) 2570 (unless (or (looking-at markdown-regex-hr) 2571 (markdown-code-block-at-point-p)) 2572 (setq stop (point)))) 2573 (markdown-cur-list-item-bounds))))) 2574 2575 (defun markdown-next-list-item-bounds () 2576 "Return bounds of next item in the same list of any level. 2577 The return value has the same form as that of 2578 `markdown-cur-list-item-bounds'." 2579 (save-excursion 2580 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2581 (end-of-list (save-excursion (markdown-end-of-list))) 2582 stop) 2583 (when cur-bounds 2584 (goto-char (nth 0 cur-bounds)) 2585 (end-of-line) 2586 (while (and (not stop) (not (eobp)) 2587 (re-search-forward markdown-regex-list 2588 end-of-list t)) 2589 (unless (or (looking-at markdown-regex-hr) 2590 (markdown-code-block-at-point-p)) 2591 (setq stop (point)))) 2592 (when stop 2593 (markdown-cur-list-item-bounds)))))) 2594 2595 (defun markdown-beginning-of-list () 2596 "Move point to beginning of list at point, if any." 2597 (interactive) 2598 (let ((orig-point (point)) 2599 (list-begin (save-excursion 2600 (markdown-search-backward-baseline) 2601 ;; Stop at next list item, regardless of the indentation. 2602 (markdown-next-list-item (point-max)) 2603 (when (looking-at markdown-regex-list) 2604 (point))))) 2605 (when (and list-begin (<= list-begin orig-point)) 2606 (goto-char list-begin)))) 2607 2608 (defun markdown-end-of-list () 2609 "Move point to end of list at point, if any." 2610 (interactive) 2611 (let ((start (point)) 2612 (end (save-excursion 2613 (when (markdown-beginning-of-list) 2614 ;; Items can't have nonlist-indent <= 1, so this 2615 ;; moves past all list items. 2616 (markdown-next-list-item 1) 2617 (skip-syntax-backward "-") 2618 (unless (eobp) (forward-char 1)) 2619 (point))))) 2620 (when (and end (>= end start)) 2621 (goto-char end)))) 2622 2623 (defun markdown-up-list () 2624 "Move point to beginning of parent list item." 2625 (interactive) 2626 (let ((cur-bounds (markdown-cur-list-item-bounds))) 2627 (when cur-bounds 2628 (markdown-prev-list-item (1- (nth 3 cur-bounds))) 2629 (let ((up-bounds (markdown-cur-list-item-bounds))) 2630 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) 2631 (point)))))) 2632 2633 (defun markdown-bounds-of-thing-at-point (thing) 2634 "Call `bounds-of-thing-at-point' for THING with slight modifications. 2635 Does not include trailing newlines when THING is 'line. Handles the 2636 end of buffer case by setting both endpoints equal to the value of 2637 `point-max', since an empty region will trigger empty markup insertion. 2638 Return bounds of form (beg . end) if THING is found, or nil otherwise." 2639 (let* ((bounds (bounds-of-thing-at-point thing)) 2640 (a (car bounds)) 2641 (b (cdr bounds))) 2642 (when bounds 2643 (when (eq thing 'line) 2644 (cond ((and (eobp) (markdown-cur-line-blank-p)) 2645 (setq a b)) 2646 ((char-equal (char-before b) ?\^J) 2647 (setq b (1- b))))) 2648 (cons a b)))) 2649 2650 (defun markdown-reference-definition (reference) 2651 "Find out whether Markdown REFERENCE is defined. 2652 REFERENCE should not include the square brackets. 2653 When REFERENCE is defined, return a list of the form (text start end) 2654 containing the definition text itself followed by the start and end 2655 locations of the text. Otherwise, return nil. 2656 Leave match data for `markdown-regex-reference-definition' 2657 intact additional processing." 2658 (let ((reference (downcase reference))) 2659 (save-excursion 2660 (goto-char (point-min)) 2661 (catch 'found 2662 (while (re-search-forward markdown-regex-reference-definition nil t) 2663 (when (string= reference (downcase (match-string-no-properties 2))) 2664 (throw 'found 2665 (list (match-string-no-properties 5) 2666 (match-beginning 5) (match-end 5))))))))) 2667 2668 (defun markdown-get-defined-references () 2669 "Return all defined reference labels and their line numbers. 2670 They does not include square brackets)." 2671 (save-excursion 2672 (goto-char (point-min)) 2673 (let (refs) 2674 (while (re-search-forward markdown-regex-reference-definition nil t) 2675 (let ((target (match-string-no-properties 2))) 2676 (cl-pushnew 2677 (cons (downcase target) 2678 (markdown-line-number-at-pos (match-beginning 2))) 2679 refs :test #'equal :key #'car))) 2680 (reverse refs)))) 2681 2682 (defun markdown-get-used-uris () 2683 "Return a list of all used URIs in the buffer." 2684 (save-excursion 2685 (goto-char (point-min)) 2686 (let (uris) 2687 (while (re-search-forward 2688 (concat "\\(?:" markdown-regex-link-inline 2689 "\\|" markdown-regex-angle-uri 2690 "\\|" markdown-regex-uri 2691 "\\|" markdown-regex-email 2692 "\\)") 2693 nil t) 2694 (unless (or (markdown-inline-code-at-point-p) 2695 (markdown-code-block-at-point-p)) 2696 (cl-pushnew (or (match-string-no-properties 6) 2697 (match-string-no-properties 10) 2698 (match-string-no-properties 12) 2699 (match-string-no-properties 13)) 2700 uris :test #'equal))) 2701 (reverse uris)))) 2702 2703 (defun markdown-inline-code-at-pos (pos) 2704 "Return non-nil if there is an inline code fragment at POS. 2705 Return nil otherwise. Set match data according to 2706 `markdown-match-code' upon success. 2707 This function searches the block for a code fragment that 2708 contains the point using `markdown-match-code'. We do this 2709 because `thing-at-point-looking-at' does not work reliably with 2710 `markdown-regex-code'. 2711 2712 The match data is set as follows: 2713 Group 1 matches the opening backquotes. 2714 Group 2 matches the code fragment itself, without backquotes. 2715 Group 3 matches the closing backquotes." 2716 (save-excursion 2717 (goto-char pos) 2718 (let ((old-point (point)) 2719 (end-of-block (progn (markdown-end-of-text-block) (point))) 2720 found) 2721 (markdown-beginning-of-text-block) 2722 (while (and (markdown-match-code end-of-block) 2723 (setq found t) 2724 (< (match-end 0) old-point))) 2725 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) 2726 (and found ; matched something 2727 (<= (match-beginning match-group) old-point) ; match contains old-point 2728 (> (match-end 0) old-point)))))) 2729 2730 (defun markdown-inline-code-at-pos-p (pos) 2731 "Return non-nil if there is an inline code fragment at POS. 2732 Like `markdown-inline-code-at-pos`, but preserves match data." 2733 (save-match-data (markdown-inline-code-at-pos pos))) 2734 2735 (defun markdown-inline-code-at-point () 2736 "Return non-nil if the point is at an inline code fragment. 2737 See `markdown-inline-code-at-pos' for details." 2738 (markdown-inline-code-at-pos (point))) 2739 2740 (defun markdown-inline-code-at-point-p (&optional pos) 2741 "Return non-nil if there is inline code at the POS. 2742 This is a predicate function counterpart to 2743 `markdown-inline-code-at-point' which does not modify the match 2744 data. See `markdown-code-block-at-point-p' for code blocks." 2745 (save-match-data (markdown-inline-code-at-pos (or pos (point))))) 2746 2747 (defun markdown-code-block-at-pos (pos) 2748 "Return match data list if there is a code block at POS. 2749 Uses text properties at the beginning of the line position. 2750 This includes pre blocks, tilde-fenced code blocks, and GFM 2751 quoted code blocks. Return nil otherwise." 2752 (let ((bol (save-excursion (goto-char pos) (point-at-bol)))) 2753 (or (get-text-property bol 'markdown-pre) 2754 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) 2755 (second (cl-second bounds))) 2756 (if second 2757 ;; chunks are right open 2758 (when (< pos second) 2759 bounds) 2760 bounds))))) 2761 2762 ;; Function was renamed to emphasize that it does not modify match-data. 2763 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) 2764 2765 (defun markdown-code-block-at-point-p (&optional pos) 2766 "Return non-nil if there is a code block at the POS. 2767 This includes pre blocks, tilde-fenced code blocks, and GFM 2768 quoted code blocks. This function does not modify the match 2769 data. See `markdown-inline-code-at-point-p' for inline code." 2770 (save-match-data (markdown-code-block-at-pos (or pos (point))))) 2771 2772 (defun markdown-heading-at-point (&optional pos) 2773 "Return non-nil if there is a heading at the POS. 2774 Set match data for `markdown-regex-header'." 2775 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) 2776 (when match-data 2777 (set-match-data match-data) 2778 t))) 2779 2780 (defun markdown-pipe-at-bol-p () 2781 "Return non-nil if the line begins with a pipe symbol. 2782 This may be useful for tables and Pandoc's line_blocks extension." 2783 (char-equal (char-after (point-at-bol)) ?|)) 2784 2785 2786 ;;; Markdown Font Lock Matching Functions ===================================== 2787 2788 (defun markdown-range-property-any (begin end prop prop-values) 2789 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. 2790 Also returns t if PROP is a list containing one of the PROP-VALUES. 2791 Return nil otherwise." 2792 (let (props) 2793 (catch 'found 2794 (dolist (loc (number-sequence begin end)) 2795 (when (setq props (get-text-property loc prop)) 2796 (cond ((listp props) 2797 ;; props is a list, check for membership 2798 (dolist (val prop-values) 2799 (when (memq val props) (throw 'found loc)))) 2800 (t 2801 ;; props is a scalar, check for equality 2802 (dolist (val prop-values) 2803 (when (eq val props) (throw 'found loc)))))))))) 2804 2805 (defun markdown-range-properties-exist (begin end props) 2806 (cl-loop 2807 for loc in (number-sequence begin end) 2808 with result = nil 2809 while (not 2810 (setq result 2811 (cl-some (lambda (prop) (get-text-property loc prop)) props))) 2812 finally return result)) 2813 2814 (defun markdown-match-inline-generic (regex last &optional faceless) 2815 "Match inline REGEX from the point to LAST. 2816 When FACELESS is non-nil, do not return matches where faces have been applied." 2817 (when (re-search-forward regex last t) 2818 (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) 2819 (face (and faceless (text-property-not-all 2820 (match-beginning 0) (match-end 0) 'face nil)))) 2821 (cond 2822 ;; In code block: move past it and recursively search again 2823 (bounds 2824 (when (< (goto-char (cl-second bounds)) last) 2825 (markdown-match-inline-generic regex last faceless))) 2826 ;; When faces are found in the match range, skip over the match and 2827 ;; recursively search again. 2828 (face 2829 (when (< (goto-char (match-end 0)) last) 2830 (markdown-match-inline-generic regex last faceless))) 2831 ;; Keep match data and return t when in bounds. 2832 (t 2833 (<= (match-end 0) last)))))) 2834 2835 (defun markdown-match-code (last) 2836 "Match inline code fragments from point to LAST." 2837 (unless (bobp) 2838 (backward-char 1)) 2839 (when (markdown-search-until-condition 2840 (lambda () 2841 (and 2842 ;; Advance point in case of failure, but without exceeding last. 2843 (goto-char (min (1+ (match-beginning 1)) last)) 2844 (not (markdown-in-comment-p (match-beginning 1))) 2845 (not (markdown-in-comment-p (match-end 1))) 2846 (not (markdown-code-block-at-pos (match-beginning 1))))) 2847 markdown-regex-code last t) 2848 (set-match-data (list (match-beginning 1) (match-end 1) 2849 (match-beginning 2) (match-end 2) 2850 (match-beginning 3) (match-end 3) 2851 (match-beginning 4) (match-end 4))) 2852 (goto-char (min (1+ (match-end 0)) last (point-max))) 2853 t)) 2854 2855 (defun markdown--gfm-markup-underscore-p (begin end) 2856 (let ((is-underscore (eql (char-after begin) ?_))) 2857 (if (not is-underscore) 2858 t 2859 (save-excursion 2860 (save-match-data 2861 (goto-char begin) 2862 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) 2863 (progn 2864 (goto-char end) 2865 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) 2866 2867 (defun markdown-match-bold (last) 2868 "Match inline bold from the point to LAST." 2869 (when (markdown-match-inline-generic markdown-regex-bold last) 2870 (let ((is-gfm (derived-mode-p 'gfm-mode)) 2871 (begin (match-beginning 2)) 2872 (end (match-end 2))) 2873 (if (or (markdown-inline-code-at-pos-p begin) 2874 (markdown-inline-code-at-pos-p end) 2875 (markdown-in-comment-p) 2876 (markdown-range-property-any 2877 begin begin 'face '(markdown-url-face 2878 markdown-plain-url-face)) 2879 (markdown-range-property-any 2880 begin end 'face '(markdown-hr-face 2881 markdown-math-face)) 2882 (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) 2883 (progn (goto-char (min (1+ begin) last)) 2884 (when (< (point) last) 2885 (markdown-match-bold last))) 2886 (set-match-data (list (match-beginning 2) (match-end 2) 2887 (match-beginning 3) (match-end 3) 2888 (match-beginning 4) (match-end 4) 2889 (match-beginning 5) (match-end 5))) 2890 t)))) 2891 2892 (defun markdown-match-italic (last) 2893 "Match inline italics from the point to LAST." 2894 (let* ((is-gfm (derived-mode-p 'gfm-mode)) 2895 (regex (if is-gfm 2896 markdown-regex-gfm-italic 2897 markdown-regex-italic))) 2898 (when (and (markdown-match-inline-generic regex last) 2899 (not (markdown--face-p 2900 (match-beginning 1) 2901 '(markdown-html-attr-name-face markdown-html-attr-value-face)))) 2902 (let ((begin (match-beginning 1)) 2903 (end (match-end 1)) 2904 (close-end (match-end 4))) 2905 (if (or (eql (char-before begin) (char-after begin)) 2906 (markdown-inline-code-at-pos-p begin) 2907 (markdown-inline-code-at-pos-p (1- end)) 2908 (markdown-in-comment-p) 2909 (markdown-range-property-any 2910 begin begin 'face '(markdown-url-face 2911 markdown-plain-url-face)) 2912 (markdown-range-property-any 2913 begin end 'face '(markdown-bold-face 2914 markdown-list-face 2915 markdown-hr-face 2916 markdown-math-face)) 2917 (and is-gfm 2918 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case 2919 (not (markdown--gfm-markup-underscore-p begin close-end))))) 2920 (progn (goto-char (min (1+ begin) last)) 2921 (when (< (point) last) 2922 (markdown-match-italic last))) 2923 (set-match-data (list (match-beginning 1) (match-end 1) 2924 (match-beginning 2) (match-end 2) 2925 (match-beginning 3) (match-end 3) 2926 (match-beginning 4) (match-end 4))) 2927 t))))) 2928 2929 (defun markdown--match-highlighting (last) 2930 (when markdown-enable-highlighting-syntax 2931 (re-search-forward markdown-regex-highlighting last t))) 2932 2933 (defun markdown-match-math-generic (regex last) 2934 "Match REGEX from point to LAST. 2935 REGEX is either `markdown-regex-math-inline-single' for matching 2936 $..$ or `markdown-regex-math-inline-double' for matching $$..$$." 2937 (when (markdown-match-inline-generic regex last) 2938 (let ((begin (match-beginning 1)) (end (match-end 1))) 2939 (prog1 2940 (if (or (markdown-range-property-any 2941 begin end 'face 2942 '(markdown-inline-code-face markdown-bold-face)) 2943 (markdown-range-properties-exist 2944 begin end 2945 (markdown-get-fenced-block-middle-properties))) 2946 (markdown-match-math-generic regex last) 2947 t) 2948 (goto-char (1+ (match-end 0))))))) 2949 2950 (defun markdown-match-list-items (last) 2951 "Match list items from point to LAST." 2952 (let* ((first (point)) 2953 (pos first) 2954 (prop 'markdown-list-item) 2955 (bounds (car (get-text-property pos prop)))) 2956 (while 2957 (and (or (null (setq bounds (car (get-text-property pos prop)))) 2958 (< (cl-first bounds) pos)) 2959 (< (point) last) 2960 (setq pos (next-single-property-change pos prop nil last)) 2961 (goto-char pos))) 2962 (when bounds 2963 (set-match-data (cl-seventh bounds)) 2964 ;; Step at least one character beyond point. Otherwise 2965 ;; `font-lock-fontify-keywords-region' infloops. 2966 (goto-char (min (1+ (max (point-at-eol) first)) 2967 (point-max))) 2968 t))) 2969 2970 (defun markdown-match-math-single (last) 2971 "Match single quoted $..$ math from point to LAST." 2972 (when markdown-enable-math 2973 (when (and (char-equal (char-after) ?$) 2974 (not (bolp)) 2975 (not (char-equal (char-before) ?\\)) 2976 (not (char-equal (char-before) ?$))) 2977 (forward-char -1)) 2978 (markdown-match-math-generic markdown-regex-math-inline-single last))) 2979 2980 (defun markdown-match-math-double (last) 2981 "Match double quoted $$..$$ math from point to LAST." 2982 (when markdown-enable-math 2983 (when (and (< (1+ (point)) (point-max)) 2984 (char-equal (char-after) ?$) 2985 (char-equal (char-after (1+ (point))) ?$) 2986 (not (bolp)) 2987 (not (char-equal (char-before) ?\\)) 2988 (not (char-equal (char-before) ?$))) 2989 (forward-char -1)) 2990 (markdown-match-math-generic markdown-regex-math-inline-double last))) 2991 2992 (defun markdown-match-math-display (last) 2993 "Match bracketed display math \[..\] and \\[..\\] from point to LAST." 2994 (when markdown-enable-math 2995 (markdown-match-math-generic markdown-regex-math-display last))) 2996 2997 (defun markdown-match-propertized-text (property last) 2998 "Match text with PROPERTY from point to LAST. 2999 Restore match data previously stored in PROPERTY." 3000 (let ((saved (get-text-property (point) property)) 3001 pos) 3002 (unless saved 3003 (setq pos (next-single-property-change (point) property nil last)) 3004 (unless (= pos last) 3005 (setq saved (get-text-property pos property)))) 3006 (when saved 3007 (set-match-data saved) 3008 ;; Step at least one character beyond point. Otherwise 3009 ;; `font-lock-fontify-keywords-region' infloops. 3010 (goto-char (min (1+ (max (match-end 0) (point))) 3011 (point-max))) 3012 saved))) 3013 3014 (defun markdown-match-pre-blocks (last) 3015 "Match preformatted blocks from point to LAST. 3016 Use data stored in 'markdown-pre text property during syntax 3017 analysis." 3018 (markdown-match-propertized-text 'markdown-pre last)) 3019 3020 (defun markdown-match-gfm-code-blocks (last) 3021 "Match GFM quoted code blocks from point to LAST. 3022 Use data stored in 'markdown-gfm-code text property during syntax 3023 analysis." 3024 (markdown-match-propertized-text 'markdown-gfm-code last)) 3025 3026 (defun markdown-match-gfm-open-code-blocks (last) 3027 (markdown-match-propertized-text 'markdown-gfm-block-begin last)) 3028 3029 (defun markdown-match-gfm-close-code-blocks (last) 3030 (markdown-match-propertized-text 'markdown-gfm-block-end last)) 3031 3032 (defun markdown-match-fenced-code-blocks (last) 3033 "Match fenced code blocks from the point to LAST." 3034 (markdown-match-propertized-text 'markdown-fenced-code last)) 3035 3036 (defun markdown-match-fenced-start-code-block (last) 3037 (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) 3038 3039 (defun markdown-match-fenced-end-code-block (last) 3040 (markdown-match-propertized-text 'markdown-tilde-fence-end last)) 3041 3042 (defun markdown-match-blockquotes (last) 3043 "Match blockquotes from point to LAST. 3044 Use data stored in 'markdown-blockquote text property during syntax 3045 analysis." 3046 (markdown-match-propertized-text 'markdown-blockquote last)) 3047 3048 (defun markdown-match-hr (last) 3049 "Match horizontal rules comments from the point to LAST." 3050 (markdown-match-propertized-text 'markdown-hr last)) 3051 3052 (defun markdown-match-comments (last) 3053 "Match HTML comments from the point to LAST." 3054 (when (and (skip-syntax-forward "^<" last)) 3055 (let ((beg (point))) 3056 (when (and (skip-syntax-forward "^>" last) (< (point) last)) 3057 (forward-char) 3058 (set-match-data (list beg (point))) 3059 t)))) 3060 3061 (defun markdown-match-generic-links (last ref) 3062 "Match inline links from point to LAST. 3063 When REF is non-nil, match reference links instead of standard 3064 links with URLs. 3065 This function should only be used during font-lock, as it 3066 determines syntax based on the presence of faces for previously 3067 processed elements." 3068 ;; Search for the next potential link (not in a code block). 3069 (let ((prohibited-faces '(markdown-pre-face 3070 markdown-code-face 3071 markdown-inline-code-face 3072 markdown-comment-face)) 3073 found) 3074 (while 3075 (and (not found) (< (point) last) 3076 (progn 3077 ;; Clear match data to test for a match after functions returns. 3078 (set-match-data nil) 3079 ;; Preliminary regular expression search so we can return 3080 ;; quickly upon failure. This doesn't handle malformed links 3081 ;; or nested square brackets well, so if it passes we back up 3082 ;; continue with a more precise search. 3083 (re-search-forward 3084 (if ref 3085 markdown-regex-link-reference 3086 markdown-regex-link-inline) 3087 last 'limit))) 3088 ;; Keep searching if this is in a code block, inline code, or a 3089 ;; comment, or if it is include syntax. The link text portion 3090 ;; (group 3) may contain inline code or comments, but the 3091 ;; markup, URL, and title should not be part of such elements. 3092 (if (or (markdown-range-property-any 3093 (match-beginning 0) (match-end 2) 'face prohibited-faces) 3094 (markdown-range-property-any 3095 (match-beginning 4) (match-end 0) 'face prohibited-faces) 3096 (and (char-equal (char-after (point-at-bol)) ?<) 3097 (char-equal (char-after (1+ (point-at-bol))) ?<))) 3098 (set-match-data nil) 3099 (setq found t)))) 3100 ;; Match opening exclamation point (optional) and left bracket. 3101 (when (match-beginning 2) 3102 (let* ((bang (match-beginning 1)) 3103 (first-begin (match-beginning 2)) 3104 ;; Find end of block to prevent matching across blocks. 3105 (end-of-block (save-excursion 3106 (progn 3107 (goto-char (match-beginning 2)) 3108 (markdown-end-of-text-block) 3109 (point)))) 3110 ;; Move over balanced expressions to closing right bracket. 3111 ;; Catch unbalanced expression errors and return nil. 3112 (first-end (condition-case nil 3113 (and (goto-char first-begin) 3114 (scan-sexps (point) 1)) 3115 (error nil))) 3116 ;; Continue with point at CONT-POINT upon failure. 3117 (cont-point (min (1+ first-begin) last)) 3118 second-begin second-end url-begin url-end 3119 title-begin title-end) 3120 ;; When bracket found, in range, and followed by a left paren/bracket... 3121 (when (and first-end (< first-end end-of-block) (goto-char first-end) 3122 (char-equal (char-after (point)) (if ref ?\[ ?\())) 3123 ;; Scan across balanced expressions for closing parenthesis/bracket. 3124 (setq second-begin (point) 3125 second-end (condition-case nil 3126 (scan-sexps (point) 1) 3127 (error nil))) 3128 ;; Check that closing parenthesis/bracket is in range. 3129 (if (and second-end (<= second-end end-of-block) (<= second-end last)) 3130 (progn 3131 ;; Search for (optional) title inside closing parenthesis 3132 (when (and (not ref) (search-forward "\"" second-end t)) 3133 (setq title-begin (1- (point)) 3134 title-end (and (goto-char second-end) 3135 (search-backward "\"" (1+ title-begin) t)) 3136 title-end (and title-end (1+ title-end)))) 3137 ;; Store URL/reference range 3138 (setq url-begin (1+ second-begin) 3139 url-end (1- (or title-begin second-end))) 3140 ;; Set match data, move point beyond link, and return 3141 (set-match-data 3142 (list (or bang first-begin) second-end ; 0 - all 3143 bang (and bang (1+ bang)) ; 1 - bang 3144 first-begin (1+ first-begin) ; 2 - markup 3145 (1+ first-begin) (1- first-end) ; 3 - link text 3146 (1- first-end) first-end ; 4 - markup 3147 second-begin (1+ second-begin) ; 5 - markup 3148 url-begin url-end ; 6 - url/reference 3149 title-begin title-end ; 7 - title 3150 (1- second-end) second-end)) ; 8 - markup 3151 ;; Nullify cont-point and leave point at end and 3152 (setq cont-point nil) 3153 (goto-char second-end)) 3154 ;; If no closing parenthesis in range, update continuation point 3155 (setq cont-point (min end-of-block second-begin)))) 3156 (cond 3157 ;; On failure, continue searching at cont-point 3158 ((and cont-point (< cont-point last)) 3159 (goto-char cont-point) 3160 (markdown-match-generic-links last ref)) 3161 ;; No more text, return nil 3162 ((and cont-point (= cont-point last)) 3163 nil) 3164 ;; Return t if a match occurred 3165 (t t))))) 3166 3167 (defun markdown-match-angle-uris (last) 3168 "Match angle bracket URIs from point to LAST." 3169 (when (markdown-match-inline-generic markdown-regex-angle-uri last) 3170 (goto-char (1+ (match-end 0))))) 3171 3172 (defun markdown-match-plain-uris (last) 3173 "Match plain URIs from point to LAST." 3174 (when (markdown-match-inline-generic markdown-regex-uri last t) 3175 (goto-char (1+ (match-end 0))))) 3176 3177 (defvar markdown-conditional-search-function #'re-search-forward 3178 "Conditional search function used in `markdown-search-until-condition'. 3179 Made into a variable to allow for dynamic let-binding.") 3180 3181 (defun markdown-search-until-condition (condition &rest args) 3182 (let (ret) 3183 (while (and (not ret) (apply markdown-conditional-search-function args)) 3184 (setq ret (funcall condition))) 3185 ret)) 3186 3187 (defun markdown-metadata-line-p (pos regexp) 3188 (save-excursion 3189 (or (= (line-number-at-pos pos) 1) 3190 (progn 3191 (forward-line -1) 3192 ;; skip multi-line metadata 3193 (while (and (looking-at-p "^\\s-+[[:alpha:]]") 3194 (> (line-number-at-pos (point)) 1)) 3195 (forward-line -1)) 3196 (looking-at-p regexp))))) 3197 3198 (defun markdown-match-generic-metadata (regexp last) 3199 "Match metadata declarations specified by REGEXP from point to LAST. 3200 These declarations must appear inside a metadata block that begins at 3201 the beginning of the buffer and ends with a blank line (or the end of 3202 the buffer)." 3203 (let* ((first (point)) 3204 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") 3205 (block-begin (goto-char 1)) 3206 (block-end (re-search-forward end-re nil t))) 3207 (if (and block-end (> first block-end)) 3208 ;; Don't match declarations if there is no metadata block or if 3209 ;; the point is beyond the block. Move point to point-max to 3210 ;; prevent additional searches and return return nil since nothing 3211 ;; was found. 3212 (progn (goto-char (point-max)) nil) 3213 ;; If a block was found that begins before LAST and ends after 3214 ;; point, search for declarations inside it. If the starting is 3215 ;; before the beginning of the block, start there. Otherwise, 3216 ;; move back to FIRST. 3217 (goto-char (if (< first block-begin) block-begin first)) 3218 (if (and (re-search-forward regexp (min last block-end) t) 3219 (markdown-metadata-line-p (point) regexp)) 3220 ;; If a metadata declaration is found, set match-data and return t. 3221 (let ((key-beginning (match-beginning 1)) 3222 (key-end (match-end 1)) 3223 (markup-begin (match-beginning 2)) 3224 (markup-end (match-end 2)) 3225 (value-beginning (match-beginning 3))) 3226 (set-match-data (list key-beginning (point) ; complete metadata 3227 key-beginning key-end ; key 3228 markup-begin markup-end ; markup 3229 value-beginning (point))) ; value 3230 t) 3231 ;; Otherwise, move the point to last and return nil 3232 (goto-char last) 3233 nil)))) 3234 3235 (defun markdown-match-declarative-metadata (last) 3236 "Match declarative metadata from the point to LAST." 3237 (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) 3238 3239 (defun markdown-match-pandoc-metadata (last) 3240 "Match Pandoc metadata from the point to LAST." 3241 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) 3242 3243 (defun markdown-match-yaml-metadata-begin (last) 3244 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) 3245 3246 (defun markdown-match-yaml-metadata-end (last) 3247 (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) 3248 3249 (defun markdown-match-yaml-metadata-key (last) 3250 (markdown-match-propertized-text 'markdown-metadata-key last)) 3251 3252 (defun markdown-match-wiki-link (last) 3253 "Match wiki links from point to LAST." 3254 (when (and markdown-enable-wiki-links 3255 (not markdown-wiki-link-fontify-missing) 3256 (markdown-match-inline-generic markdown-regex-wiki-link last)) 3257 (let ((begin (match-beginning 1)) (end (match-end 1))) 3258 (if (or (markdown-in-comment-p begin) 3259 (markdown-in-comment-p end) 3260 (markdown-inline-code-at-pos-p begin) 3261 (markdown-inline-code-at-pos-p end) 3262 (markdown-code-block-at-pos begin)) 3263 (progn (goto-char (min (1+ begin) last)) 3264 (when (< (point) last) 3265 (markdown-match-wiki-link last))) 3266 (set-match-data (list begin end)) 3267 t)))) 3268 3269 (defun markdown-match-inline-attributes (last) 3270 "Match inline attributes from point to LAST." 3271 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. 3272 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes 3273 ;; against matched string. 3274 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) 3275 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) 3276 (markdown-match-inline-attributes last) 3277 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3278 (markdown-inline-code-at-pos-p (match-end 0)) 3279 (markdown-in-comment-p)) 3280 t)))) 3281 3282 (defun markdown-match-leanpub-sections (last) 3283 "Match Leanpub section markers from point to LAST." 3284 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) 3285 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3286 (markdown-inline-code-at-pos-p (match-end 0)) 3287 (markdown-in-comment-p)) 3288 t))) 3289 3290 (defun markdown-match-includes (last) 3291 "Match include statements from point to LAST. 3292 Sets match data for the following seven groups: 3293 Group 1: opening two angle brackets 3294 Group 2: opening title delimiter (optional) 3295 Group 3: title text (optional) 3296 Group 4: closing title delimiter (optional) 3297 Group 5: opening filename delimiter 3298 Group 6: filename 3299 Group 7: closing filename delimiter" 3300 (when (markdown-match-inline-generic markdown-regex-include last) 3301 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) 3302 (markdown-in-comment-p (match-end 0)) 3303 (markdown-code-block-at-pos (match-beginning 0)))))) 3304 (cond 3305 ;; Parentheses and maybe square brackets, but no curly braces: 3306 ;; match optional title in square brackets and file in parentheses. 3307 ((and valid (match-beginning 5) 3308 (not (match-beginning 8))) 3309 (set-match-data (list (match-beginning 1) (match-end 7) 3310 (match-beginning 1) (match-end 1) 3311 (match-beginning 2) (match-end 2) 3312 (match-beginning 3) (match-end 3) 3313 (match-beginning 4) (match-end 4) 3314 (match-beginning 5) (match-end 5) 3315 (match-beginning 6) (match-end 6) 3316 (match-beginning 7) (match-end 7)))) 3317 ;; Only square brackets present: match file in square brackets. 3318 ((and valid (match-beginning 2) 3319 (not (match-beginning 5)) 3320 (not (match-beginning 7))) 3321 (set-match-data (list (match-beginning 1) (match-end 4) 3322 (match-beginning 1) (match-end 1) 3323 nil nil 3324 nil nil 3325 nil nil 3326 (match-beginning 2) (match-end 2) 3327 (match-beginning 3) (match-end 3) 3328 (match-beginning 4) (match-end 4)))) 3329 ;; Only curly braces present: match file in curly braces. 3330 ((and valid (match-beginning 8) 3331 (not (match-beginning 2)) 3332 (not (match-beginning 5))) 3333 (set-match-data (list (match-beginning 1) (match-end 10) 3334 (match-beginning 1) (match-end 1) 3335 nil nil 3336 nil nil 3337 nil nil 3338 (match-beginning 8) (match-end 8) 3339 (match-beginning 9) (match-end 9) 3340 (match-beginning 10) (match-end 10)))) 3341 (t 3342 ;; Not a valid match, move to next line and search again. 3343 (forward-line) 3344 (when (< (point) last) 3345 (setq valid (markdown-match-includes last))))) 3346 valid))) 3347 3348 (defun markdown-match-html-tag (last) 3349 "Match HTML tags from point to LAST." 3350 (when (and markdown-enable-html 3351 (markdown-match-inline-generic markdown-regex-html-tag last t)) 3352 (set-match-data (list (match-beginning 0) (match-end 0) 3353 (match-beginning 1) (match-end 1) 3354 (match-beginning 2) (match-end 2) 3355 (match-beginning 9) (match-end 9))) 3356 t)) 3357 3358 3359 ;;; Markdown Font Fontification Functions ===================================== 3360 3361 (defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) 3362 3363 (defun markdown--first-displayable (seq) 3364 "Return the first displayable character or string in SEQ. 3365 SEQ may be an atom or a sequence." 3366 (let ((c (gethash seq markdown--first-displayable-cache t))) 3367 (if (not (eq c t)) 3368 c 3369 (puthash seq 3370 (let ((seq (if (listp seq) seq (list seq)))) 3371 (cond ((stringp (car seq)) 3372 (cl-find-if 3373 (lambda (str) 3374 (and (mapcar #'char-displayable-p (string-to-list str)))) 3375 seq)) 3376 ((characterp (car seq)) 3377 (cl-find-if #'char-displayable-p seq)))) 3378 markdown--first-displayable-cache)))) 3379 3380 (defun markdown--marginalize-string (level) 3381 "Generate atx markup string of given LEVEL for left margin." 3382 (let ((margin-left-space-count 3383 (- markdown-marginalize-headers-margin-width level))) 3384 (concat (make-string margin-left-space-count ? ) 3385 (make-string level ?#)))) 3386 3387 (defun markdown-marginalize-update-current () 3388 "Update the window configuration to create a left margin." 3389 (if window-system 3390 (let* ((header-delimiter-font-width 3391 (window-font-width nil 'markdown-header-delimiter-face)) 3392 (margin-pixel-width (* markdown-marginalize-headers-margin-width 3393 header-delimiter-font-width)) 3394 (margin-char-width (/ margin-pixel-width (default-font-width)))) 3395 (set-window-margins nil margin-char-width)) 3396 ;; As a fallback, simply set margin based on character count. 3397 (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) 3398 3399 (defun markdown-fontify-headings (last) 3400 "Add text properties to headings from point to LAST." 3401 (when (markdown-match-propertized-text 'markdown-heading last) 3402 (let* ((level (markdown-outline-level)) 3403 (heading-face 3404 (intern (format "markdown-header-face-%d" level))) 3405 (heading-props `(face ,heading-face)) 3406 (left-markup-props 3407 `(face markdown-header-delimiter-face 3408 ,@(cond 3409 (markdown-hide-markup 3410 `(display "")) 3411 (markdown-marginalize-headers 3412 `(display ((margin left-margin) 3413 ,(markdown--marginalize-string level))))))) 3414 (right-markup-props 3415 `(face markdown-header-delimiter-face 3416 ,@(when markdown-hide-markup `(display "")))) 3417 (rule-props `(face markdown-header-rule-face 3418 ,@(when markdown-hide-markup `(display ""))))) 3419 (if (match-end 1) 3420 ;; Setext heading 3421 (progn (add-text-properties 3422 (match-beginning 1) (match-end 1) heading-props) 3423 (if (= level 1) 3424 (add-text-properties 3425 (match-beginning 2) (match-end 2) rule-props) 3426 (add-text-properties 3427 (match-beginning 3) (match-end 3) rule-props))) 3428 ;; atx heading 3429 (add-text-properties 3430 (match-beginning 4) (match-end 4) left-markup-props) 3431 (add-text-properties 3432 (match-beginning 5) (match-end 5) heading-props) 3433 (when (match-end 6) 3434 (add-text-properties 3435 (match-beginning 6) (match-end 6) right-markup-props)))) 3436 t)) 3437 3438 (defun markdown-fontify-tables (last) 3439 (when (re-search-forward "|" last t) 3440 (when (markdown-table-at-point-p) 3441 (font-lock-append-text-property 3442 (line-beginning-position) (min (1+ (line-end-position)) (point-max)) 3443 'face 'markdown-table-face)) 3444 (forward-line 1) 3445 t)) 3446 3447 (defun markdown-fontify-blockquotes (last) 3448 "Apply font-lock properties to blockquotes from point to LAST." 3449 (when (markdown-match-blockquotes last) 3450 (let ((display-string 3451 (markdown--first-displayable markdown-blockquote-display-char))) 3452 (add-text-properties 3453 (match-beginning 1) (match-end 1) 3454 (if markdown-hide-markup 3455 `(face markdown-blockquote-face display ,display-string) 3456 `(face markdown-markup-face))) 3457 (font-lock-append-text-property 3458 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) 3459 t))) 3460 3461 (defun markdown-fontify-list-items (last) 3462 "Apply font-lock properties to list markers from point to LAST." 3463 (when (markdown-match-list-items last) 3464 (when (not (markdown-code-block-at-point-p (match-beginning 2))) 3465 (let* ((indent (length (match-string-no-properties 1))) 3466 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... 3467 (bullet (nth (mod level (length markdown-list-item-bullets)) 3468 markdown-list-item-bullets))) 3469 (add-text-properties 3470 (match-beginning 2) (match-end 2) '(face markdown-list-face)) 3471 (when markdown-hide-markup 3472 (cond 3473 ;; Unordered lists 3474 ((string-match-p "[\\*\\+-]" (match-string 2)) 3475 (add-text-properties 3476 (match-beginning 2) (match-end 2) `(display ,bullet))) 3477 ;; Definition lists 3478 ((string-equal ":" (match-string 2)) 3479 (let ((display-string 3480 (char-to-string (markdown--first-displayable 3481 markdown-definition-display-char)))) 3482 (add-text-properties (match-beginning 2) (match-end 2) 3483 `(display ,display-string)))))))) 3484 t)) 3485 3486 (defun markdown-fontify-hrs (last) 3487 "Add text properties to horizontal rules from point to LAST." 3488 (when (markdown-match-hr last) 3489 (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) 3490 (add-text-properties 3491 (match-beginning 0) (match-end 0) 3492 `(face markdown-hr-face 3493 font-lock-multiline t 3494 ,@(when (and markdown-hide-markup hr-char) 3495 `(display ,(make-string 3496 (1- (window-body-width)) hr-char))))) 3497 t))) 3498 3499 (defun markdown-fontify-sub-superscripts (last) 3500 "Apply text properties to sub- and superscripts from point to LAST." 3501 (when (markdown-search-until-condition 3502 (lambda () (and (not (markdown-code-block-at-point-p)) 3503 (not (markdown-inline-code-at-point-p)) 3504 (not (markdown-in-comment-p)))) 3505 markdown-regex-sub-superscript last t) 3506 (let* ((subscript-p (string= (match-string 2) "~")) 3507 (props 3508 (if subscript-p 3509 (car markdown-sub-superscript-display) 3510 (cdr markdown-sub-superscript-display))) 3511 (mp (list 'face 'markdown-markup-face 3512 'invisible 'markdown-markup))) 3513 (when markdown-hide-markup 3514 (put-text-property (match-beginning 3) (match-end 3) 3515 'display props)) 3516 (add-text-properties (match-beginning 2) (match-end 2) mp) 3517 (add-text-properties (match-beginning 4) (match-end 4) mp) 3518 t))) 3519 3520 3521 ;;; Syntax Table ============================================================== 3522 3523 (defvar markdown-mode-syntax-table 3524 (let ((tab (make-syntax-table text-mode-syntax-table))) 3525 (modify-syntax-entry ?\" "." tab) 3526 tab) 3527 "Syntax table for `markdown-mode'.") 3528 3529 3530 ;;; Element Insertion ========================================================= 3531 3532 (defun markdown-ensure-blank-line-before () 3533 "If previous line is not already blank, insert a blank line before point." 3534 (unless (bolp) (insert "\n")) 3535 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) 3536 3537 (defun markdown-ensure-blank-line-after () 3538 "If following line is not already blank, insert a blank line after point. 3539 Return the point where it was originally." 3540 (save-excursion 3541 (unless (eolp) (insert "\n")) 3542 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) 3543 3544 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) 3545 "Insert the strings S1 and S2, wrapping around region or THING. 3546 If a region is specified by the optional BEG and END arguments, 3547 wrap the strings S1 and S2 around that region. 3548 If there is an active region, wrap the strings S1 and S2 around 3549 the region. If there is not an active region but the point is at 3550 THING, wrap that thing (which defaults to word). Otherwise, just 3551 insert S1 and S2 and place the point in between. Return the 3552 bounds of the entire wrapped string, or nil if nothing was wrapped 3553 and S1 and S2 were only inserted." 3554 (let (a b bounds new-point) 3555 (cond 3556 ;; Given region 3557 ((and beg end) 3558 (setq a beg 3559 b end 3560 new-point (+ (point) (length s1)))) 3561 ;; Active region 3562 ((use-region-p) 3563 (setq a (region-beginning) 3564 b (region-end) 3565 new-point (+ (point) (length s1)))) 3566 ;; Thing (word) at point 3567 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) 3568 (setq a (car bounds) 3569 b (cdr bounds) 3570 new-point (+ (point) (length s1)))) 3571 ;; No active region and no word 3572 (t 3573 (setq a (point) 3574 b (point)))) 3575 (goto-char b) 3576 (insert s2) 3577 (goto-char a) 3578 (insert s1) 3579 (when new-point (goto-char new-point)) 3580 (if (= a b) 3581 nil 3582 (setq b (+ b (length s1) (length s2))) 3583 (cons a b)))) 3584 3585 (defun markdown-point-after-unwrap (cur prefix suffix) 3586 "Return desired position of point after an unwrapping operation. 3587 CUR gives the position of the point before the operation. 3588 Additionally, two cons cells must be provided. PREFIX gives the 3589 bounds of the prefix string and SUFFIX gives the bounds of the 3590 suffix string." 3591 (cond ((< cur (cdr prefix)) (car prefix)) 3592 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) 3593 ((<= cur (cdr suffix)) 3594 (- cur (+ (- (cdr prefix) (car prefix)) 3595 (- cur (car suffix))))) 3596 (t cur))) 3597 3598 (defun markdown-unwrap-thing-at-point (regexp all text) 3599 "Remove prefix and suffix of thing at point and reposition the point. 3600 When the thing at point matches REGEXP, replace the subexpression 3601 ALL with the string in subexpression TEXT. Reposition the point 3602 in an appropriate location accounting for the removal of prefix 3603 and suffix strings. Return new bounds of string from group TEXT. 3604 When REGEXP is nil, assumes match data is already set." 3605 (when (or (null regexp) 3606 (thing-at-point-looking-at regexp)) 3607 (let ((cur (point)) 3608 (prefix (cons (match-beginning all) (match-beginning text))) 3609 (suffix (cons (match-end text) (match-end all))) 3610 (bounds (cons (match-beginning text) (match-end text)))) 3611 ;; Replace the thing at point 3612 (replace-match (match-string text) t t nil all) 3613 ;; Reposition the point 3614 (goto-char (markdown-point-after-unwrap cur prefix suffix)) 3615 ;; Adjust bounds 3616 (setq bounds (cons (car prefix) 3617 (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) 3618 3619 (defun markdown-unwrap-things-in-region (beg end regexp all text) 3620 "Remove prefix and suffix of all things in region from BEG to END. 3621 When a thing in the region matches REGEXP, replace the 3622 subexpression ALL with the string in subexpression TEXT. 3623 Return a cons cell containing updated bounds for the region." 3624 (save-excursion 3625 (goto-char beg) 3626 (let ((removed 0) len-all len-text) 3627 (while (re-search-forward regexp (- end removed) t) 3628 (setq len-all (length (match-string-no-properties all))) 3629 (setq len-text (length (match-string-no-properties text))) 3630 (setq removed (+ removed (- len-all len-text))) 3631 (replace-match (match-string text) t t nil all)) 3632 (cons beg (- end removed))))) 3633 3634 (defun markdown-insert-hr (arg) 3635 "Insert or replace a horizontal rule. 3636 By default, use the first element of `markdown-hr-strings'. When 3637 ARG is non-nil, as when given a prefix, select a different 3638 element as follows. When prefixed with \\[universal-argument], 3639 use the last element of `markdown-hr-strings' instead. When 3640 prefixed with an integer from 1 to the length of 3641 `markdown-hr-strings', use the element in that position instead." 3642 (interactive "*P") 3643 (when (thing-at-point-looking-at markdown-regex-hr) 3644 (delete-region (match-beginning 0) (match-end 0))) 3645 (markdown-ensure-blank-line-before) 3646 (cond ((equal arg '(4)) 3647 (insert (car (reverse markdown-hr-strings)))) 3648 ((and (integerp arg) (> arg 0) 3649 (<= arg (length markdown-hr-strings))) 3650 (insert (nth (1- arg) markdown-hr-strings))) 3651 (t 3652 (insert (car markdown-hr-strings)))) 3653 (markdown-ensure-blank-line-after)) 3654 3655 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face 3656 &optional skip-space) 3657 (if (use-region-p) 3658 ;; Active region 3659 (let* ((bounds (markdown-unwrap-things-in-region 3660 (region-beginning) (region-end) 3661 regex start-group end-group)) 3662 (beg (car bounds)) 3663 (end (cdr bounds))) 3664 (when (and beg skip-space) 3665 (save-excursion 3666 (goto-char beg) 3667 (skip-chars-forward "[ \t]") 3668 (setq beg (point)))) 3669 (when (and end skip-space) 3670 (save-excursion 3671 (goto-char end) 3672 (skip-chars-backward "[ \t]") 3673 (setq end (point)))) 3674 (markdown-wrap-or-insert start-delim end-delim nil beg end)) 3675 (if (markdown--face-p (point) (list face)) 3676 (save-excursion 3677 (while (and (markdown--face-p (point) (list face)) (not (bobp))) 3678 (forward-char -1)) 3679 (forward-char (- (1- (length start-delim)))) ;; for delimiter 3680 (unless (bolp) 3681 (forward-char -1)) 3682 (when (looking-at regex) 3683 (markdown-unwrap-thing-at-point nil start-group end-group))) 3684 (if (thing-at-point-looking-at regex) 3685 (markdown-unwrap-thing-at-point nil start-group end-group) 3686 (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) 3687 3688 (defun markdown-insert-bold () 3689 "Insert markup to make a region or word bold. 3690 If there is an active region, make the region bold. If the point 3691 is at a non-bold word, make the word bold. If the point is at a 3692 bold word or phrase, remove the bold markup. Otherwise, simply 3693 insert bold delimiters and place the point in between them." 3694 (interactive) 3695 (let ((delim (if markdown-bold-underscore "__" "**"))) 3696 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) 3697 3698 (defun markdown-insert-italic () 3699 "Insert markup to make a region or word italic. 3700 If there is an active region, make the region italic. If the point 3701 is at a non-italic word, make the word italic. If the point is at an 3702 italic word or phrase, remove the italic markup. Otherwise, simply 3703 insert italic delimiters and place the point in between them." 3704 (interactive) 3705 (let ((delim (if markdown-italic-underscore "_" "*"))) 3706 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) 3707 3708 (defun markdown-insert-strike-through () 3709 "Insert markup to make a region or word strikethrough. 3710 If there is an active region, make the region strikethrough. If the point 3711 is at a non-bold word, make the word strikethrough. If the point is at a 3712 strikethrough word or phrase, remove the strikethrough markup. Otherwise, 3713 simply insert bold delimiters and place the point in between them." 3714 (interactive) 3715 (markdown--insert-common 3716 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) 3717 3718 (defun markdown-insert-code () 3719 "Insert markup to make a region or word an inline code fragment. 3720 If there is an active region, make the region an inline code 3721 fragment. If the point is at a word, make the word an inline 3722 code fragment. Otherwise, simply insert code delimiters and 3723 place the point in between them." 3724 (interactive) 3725 (if (use-region-p) 3726 ;; Active region 3727 (let ((bounds (markdown-unwrap-things-in-region 3728 (region-beginning) (region-end) 3729 markdown-regex-code 1 3))) 3730 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) 3731 ;; Code markup removal, code markup for word, or empty markup insertion 3732 (if (markdown-inline-code-at-point) 3733 (markdown-unwrap-thing-at-point nil 0 2) 3734 (markdown-wrap-or-insert "`" "`" 'word nil nil)))) 3735 3736 (defun markdown-insert-kbd () 3737 "Insert markup to wrap region or word in <kbd> tags. 3738 If there is an active region, use the region. If the point is at 3739 a word, use the word. Otherwise, simply insert <kbd> tags and 3740 place the point in between them." 3741 (interactive) 3742 (if (use-region-p) 3743 ;; Active region 3744 (let ((bounds (markdown-unwrap-things-in-region 3745 (region-beginning) (region-end) 3746 markdown-regex-kbd 0 2))) 3747 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) 3748 ;; Markup removal, markup for word, or empty markup insertion 3749 (if (thing-at-point-looking-at markdown-regex-kbd) 3750 (markdown-unwrap-thing-at-point nil 0 2) 3751 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) 3752 3753 (defun markdown-insert-inline-link (text url &optional title) 3754 "Insert an inline link with TEXT pointing to URL. 3755 Optionally, the user can provide a TITLE." 3756 (let ((cur (point))) 3757 (setq title (and title (concat " \"" title "\""))) 3758 (insert (concat "[" text "](" url title ")")) 3759 (cond ((not text) (goto-char (+ 1 cur))) 3760 ((not url) (goto-char (+ 3 (length text) cur)))))) 3761 3762 (defun markdown-insert-inline-image (text url &optional title) 3763 "Insert an inline link with alt TEXT pointing to URL. 3764 Optionally, also provide a TITLE." 3765 (let ((cur (point))) 3766 (setq title (and title (concat " \"" title "\""))) 3767 (insert (concat "")) 3768 (cond ((not text) (goto-char (+ 2 cur))) 3769 ((not url) (goto-char (+ 4 (length text) cur)))))) 3770 3771 (defun markdown-insert-reference-link (text label &optional url title) 3772 "Insert a reference link and, optionally, a reference definition. 3773 The link TEXT will be inserted followed by the optional LABEL. 3774 If a URL is given, also insert a definition for the reference 3775 LABEL according to `markdown-reference-location'. If a TITLE is 3776 given, it will be added to the end of the reference definition 3777 and will be used to populate the title attribute when converted 3778 to XHTML. If URL is nil, insert only the link portion (for 3779 example, when a reference label is already defined)." 3780 (insert (concat "[" text "][" label "]")) 3781 (when url 3782 (markdown-insert-reference-definition 3783 (if (string-equal label "") text label) 3784 url title))) 3785 3786 (defun markdown-insert-reference-image (text label &optional url title) 3787 "Insert a reference image and, optionally, a reference definition. 3788 The alt TEXT will be inserted followed by the optional LABEL. 3789 If a URL is given, also insert a definition for the reference 3790 LABEL according to `markdown-reference-location'. If a TITLE is 3791 given, it will be added to the end of the reference definition 3792 and will be used to populate the title attribute when converted 3793 to XHTML. If URL is nil, insert only the link portion (for 3794 example, when a reference label is already defined)." 3795 (insert (concat "![" text "][" label "]")) 3796 (when url 3797 (markdown-insert-reference-definition 3798 (if (string-equal label "") text label) 3799 url title))) 3800 3801 (defun markdown-insert-reference-definition (label &optional url title) 3802 "Add definition for reference LABEL with URL and TITLE. 3803 LABEL is a Markdown reference label without square brackets. 3804 URL and TITLE are optional. When given, the TITLE will 3805 be used to populate the title attribute when converted to XHTML." 3806 ;; END specifies where to leave the point upon return 3807 (let ((end (point))) 3808 (cl-case markdown-reference-location 3809 (end (goto-char (point-max))) 3810 (immediately (markdown-end-of-text-block)) 3811 (subtree (markdown-end-of-subtree)) 3812 (header (markdown-end-of-defun))) 3813 ;; Skip backwards over local variables. This logic is similar to the one 3814 ;; used in ‘hack-local-variables’. 3815 (when (and enable-local-variables (eobp)) 3816 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) 3817 (when (let ((case-fold-search t)) 3818 (search-forward "Local Variables:" nil :move)) 3819 (beginning-of-line 0) 3820 (when (eq (char-before) ?\n) (backward-char)))) 3821 (unless (or (markdown-cur-line-blank-p) 3822 (thing-at-point-looking-at markdown-regex-reference-definition)) 3823 (insert "\n")) 3824 (insert "\n[" label "]: ") 3825 (if url 3826 (insert url) 3827 ;; When no URL is given, leave point at END following the colon 3828 (setq end (point))) 3829 (when (> (length title) 0) 3830 (insert " \"" title "\"")) 3831 (unless (looking-at-p "\n") 3832 (insert "\n")) 3833 (goto-char end) 3834 (when url 3835 (message 3836 (markdown--substitute-command-keys 3837 "Reference [%s] was defined, press \\[markdown-do] to jump there") 3838 label)))) 3839 3840 (defcustom markdown-link-make-text-function nil 3841 "Function that automatically generates a link text for a URL. 3842 3843 If non-nil, this function will be called by 3844 `markdown--insert-link-or-image' and the result will be the 3845 default link text. The function should receive exactly one 3846 argument that corresponds to the link URL." 3847 :group 'markdown 3848 :type 'function 3849 :package-version '(markdown-mode . "2.5")) 3850 3851 (defcustom markdown-disable-tooltip-prompt nil 3852 "Disable prompt for tooltip when inserting a link or image. 3853 3854 If non-nil, `markdown-insert-link' and `markdown-insert-link' 3855 will not prompt the user to insert a tooltip text for the given 3856 link or image." 3857 :group 'markdown 3858 :type 'boolean 3859 :safe 'booleanp 3860 :package-version '(markdown-mode . "2.5")) 3861 3862 (defun markdown--insert-link-or-image (image) 3863 "Interactively insert new or update an existing link or image. 3864 When IMAGE is non-nil, insert an image. Otherwise, insert a link. 3865 This is an internal function called by 3866 `markdown-insert-link' and `markdown-insert-image'." 3867 (cl-multiple-value-bind (begin end text uri ref title) 3868 (if (use-region-p) 3869 ;; Use region as either link text or URL as appropriate. 3870 (let ((region (buffer-substring-no-properties 3871 (region-beginning) (region-end)))) 3872 (if (string-match markdown-regex-uri region) 3873 ;; Region contains a URL; use it as such. 3874 (list (region-beginning) (region-end) 3875 nil (match-string 0 region) nil nil) 3876 ;; Region doesn't contain a URL, so use it as text. 3877 (list (region-beginning) (region-end) 3878 region nil nil nil))) 3879 ;; Extract and use properties of existing link, if any. 3880 (markdown-link-at-pos (point))) 3881 (let* ((ref (when ref (concat "[" ref "]"))) 3882 (defined-refs (mapcar #'car (markdown-get-defined-references))) 3883 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) 3884 (used-uris (markdown-get-used-uris)) 3885 (uri-or-ref (completing-read 3886 "URL or [reference]: " 3887 (append defined-ref-cands used-uris) 3888 nil nil (or uri ref))) 3889 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) 3890 (match-string 1 uri-or-ref)) 3891 ((string-equal "" uri-or-ref) 3892 ""))) 3893 (uri (unless ref uri-or-ref)) 3894 (text-prompt (if image 3895 "Alt text: " 3896 (if ref 3897 "Link text: " 3898 "Link text (blank for plain URL): "))) 3899 (text (or text (and markdown-link-make-text-function uri 3900 (funcall markdown-link-make-text-function uri)))) 3901 (text (completing-read text-prompt defined-refs nil nil text)) 3902 (text (if (= (length text) 0) nil text)) 3903 (plainp (and uri (not text))) 3904 (implicitp (string-equal ref "")) 3905 (ref (if implicitp text ref)) 3906 (definedp (and ref (markdown-reference-definition ref))) 3907 (ref-url (unless (or uri definedp) 3908 (completing-read "Reference URL: " used-uris))) 3909 (title (unless (or plainp definedp markdown-disable-tooltip-prompt) 3910 (read-string "Title (tooltip text, optional): " title))) 3911 (title (if (= (length title) 0) nil title))) 3912 (when (and image implicitp) 3913 (user-error "Reference required: implicit image references are invalid")) 3914 (when (and begin end) 3915 (delete-region begin end)) 3916 (cond 3917 ((and (not image) uri text) 3918 (markdown-insert-inline-link text uri title)) 3919 ((and image uri text) 3920 (markdown-insert-inline-image text uri title)) 3921 ((and ref text) 3922 (if image 3923 (markdown-insert-reference-image text (unless implicitp ref) nil title) 3924 (markdown-insert-reference-link text (unless implicitp ref) nil title)) 3925 (unless definedp 3926 (markdown-insert-reference-definition ref ref-url title))) 3927 ((and (not image) uri) 3928 (markdown-insert-uri uri)))))) 3929 3930 (defun markdown-insert-link () 3931 "Insert new or update an existing link, with interactive prompt. 3932 If the point is at an existing link or URL, update the link text, 3933 URL, reference label, and/or title. Otherwise, insert a new link. 3934 The type of link inserted (inline, reference, or plain URL) 3935 depends on which values are provided: 3936 3937 * If a URL and TEXT are given, insert an inline link: [TEXT](URL). 3938 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. 3939 * If only TEXT is given, insert an implicit reference link: [TEXT][]. 3940 * If only a URL is given, insert a plain link: <URL>. 3941 3942 In other words, to create an implicit reference link, leave the 3943 URL prompt empty and to create a plain URL link, leave the link 3944 text empty. 3945 3946 If there is an active region, use the text as the default URL, if 3947 it seems to be a URL, or link text value otherwise. 3948 3949 If a given reference is not defined, this function will 3950 additionally prompt for the URL and optional title. In this case, 3951 the reference definition is placed at the location determined by 3952 `markdown-reference-location'. In addition, it is possible to 3953 have the `markdown-link-make-text-function' function, if non-nil, 3954 define the default link text before prompting the user for it. 3955 3956 If `markdown-disable-tooltip-prompt' is non-nil, the user will 3957 not be prompted to add or modify a tooltip text. 3958 3959 Through updating the link, this function can be used to convert a 3960 link of one type (inline, reference, or plain) to another type by 3961 selectively adding or removing information via the prompts." 3962 (interactive) 3963 (markdown--insert-link-or-image nil)) 3964 3965 (defun markdown-insert-image () 3966 "Insert new or update an existing image, with interactive prompt. 3967 If the point is at an existing image, update the alt text, URL, 3968 reference label, and/or title. Otherwise, insert a new image. 3969 The type of image inserted (inline or reference) depends on which 3970 values are provided: 3971 3972 * If a URL and ALT-TEXT are given, insert an inline image: 3973 . 3974 * If [REF] and ALT-TEXT are given, insert a reference image: 3975 ![ALT-TEXT][REF]. 3976 3977 If there is an active region, use the text as the default URL, if 3978 it seems to be a URL, or alt text value otherwise. 3979 3980 If a given reference is not defined, this function will 3981 additionally prompt for the URL and optional title. In this case, 3982 the reference definition is placed at the location determined by 3983 `markdown-reference-location'. 3984 3985 Through updating the image, this function can be used to convert an 3986 image of one type (inline or reference) to another type by 3987 selectively adding or removing information via the prompts." 3988 (interactive) 3989 (markdown--insert-link-or-image t)) 3990 3991 (defun markdown-insert-uri (&optional uri) 3992 "Insert markup for an inline URI. 3993 If there is an active region, use it as the URI. If the point is 3994 at a URI, wrap it with angle brackets. If the point is at an 3995 inline URI, remove the angle brackets. Otherwise, simply insert 3996 angle brackets place the point between them." 3997 (interactive) 3998 (if (use-region-p) 3999 ;; Active region 4000 (let ((bounds (markdown-unwrap-things-in-region 4001 (region-beginning) (region-end) 4002 markdown-regex-angle-uri 0 2))) 4003 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) 4004 ;; Markup removal, URI at point, new URI, or empty markup insertion 4005 (if (thing-at-point-looking-at markdown-regex-angle-uri) 4006 (markdown-unwrap-thing-at-point nil 0 2) 4007 (if uri 4008 (insert "<" uri ">") 4009 (markdown-wrap-or-insert "<" ">" 'url nil nil))))) 4010 4011 (defun markdown-insert-wiki-link () 4012 "Insert a wiki link of the form [[WikiLink]]. 4013 If there is an active region, use the region as the link text. 4014 If the point is at a word, use the word as the link text. If 4015 there is no active region and the point is not at word, simply 4016 insert link markup." 4017 (interactive) 4018 (if (use-region-p) 4019 ;; Active region 4020 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) 4021 ;; Markup removal, wiki link at at point, or empty markup insertion 4022 (if (thing-at-point-looking-at markdown-regex-wiki-link) 4023 (if (or markdown-wiki-link-alias-first 4024 (null (match-string 5))) 4025 (markdown-unwrap-thing-at-point nil 1 3) 4026 (markdown-unwrap-thing-at-point nil 1 5)) 4027 (markdown-wrap-or-insert "[[" "]]")))) 4028 4029 (defun markdown-remove-header () 4030 "Remove header markup if point is at a header. 4031 Return bounds of remaining header text if a header was removed 4032 and nil otherwise." 4033 (interactive "*") 4034 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) 4035 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) 4036 4037 (defun markdown-insert-header (&optional level text setext) 4038 "Insert or replace header markup. 4039 The level of the header is specified by LEVEL and header text is 4040 given by TEXT. LEVEL must be an integer from 1 and 6, and the 4041 default value is 1. 4042 When TEXT is nil, the header text is obtained as follows. 4043 If there is an active region, it is used as the header text. 4044 Otherwise, the current line will be used as the header text. 4045 If there is not an active region and the point is at a header, 4046 remove the header markup and replace with level N header. 4047 Otherwise, insert empty header markup and place the point in 4048 between. 4049 The style of the header will be atx (hash marks) unless 4050 SETEXT is non-nil, in which case a setext-style (underlined) 4051 header will be inserted." 4052 (interactive "p\nsHeader text: ") 4053 (setq level (min (max (or level 1) 1) (if setext 2 6))) 4054 ;; Determine header text if not given 4055 (when (null text) 4056 (if (use-region-p) 4057 ;; Active region 4058 (setq text (delete-and-extract-region (region-beginning) (region-end))) 4059 ;; No active region 4060 (markdown-remove-header) 4061 (setq text (delete-and-extract-region 4062 (line-beginning-position) (line-end-position))) 4063 (when (and setext (string-match-p "^[ \t]*$" text)) 4064 (setq text (read-string "Header text: ")))) 4065 (setq text (markdown-compress-whitespace-string text))) 4066 ;; Insertion with given text 4067 (markdown-ensure-blank-line-before) 4068 (let (hdr) 4069 (cond (setext 4070 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) 4071 (insert text "\n" hdr)) 4072 (t 4073 (setq hdr (make-string level ?#)) 4074 (insert hdr " " text) 4075 (when (null markdown-asymmetric-header) (insert " " hdr))))) 4076 (markdown-ensure-blank-line-after) 4077 ;; Leave point at end of text 4078 (cond (setext 4079 (backward-char (1+ (string-width text)))) 4080 ((null markdown-asymmetric-header) 4081 (backward-char (1+ level))))) 4082 4083 (defun markdown-insert-header-dwim (&optional arg setext) 4084 "Insert or replace header markup. 4085 The level and type of the header are determined automatically by 4086 the type and level of the previous header, unless a prefix 4087 argument is given via ARG. 4088 With a numeric prefix valued 1 to 6, insert a header of the given 4089 level, with the type being determined automatically (note that 4090 only level 1 or 2 setext headers are possible). 4091 4092 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 4093 promote the heading by one level. 4094 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 4095 demote the heading by one level. 4096 When SETEXT is non-nil, prefer setext-style headers when 4097 possible (levels one and two). 4098 4099 When there is an active region, use it for the header text. When 4100 the point is at an existing header, change the type and level 4101 according to the rules above. 4102 Otherwise, if the line is not empty, create a header using the 4103 text on the current line as the header text. 4104 Finally, if the point is on a blank line, insert empty header 4105 markup (atx) or prompt for text (setext). 4106 See `markdown-insert-header' for more details about how the 4107 header text is determined." 4108 (interactive "*P") 4109 (let (level) 4110 (save-excursion 4111 (when (or (thing-at-point-looking-at markdown-regex-header) 4112 (re-search-backward markdown-regex-header nil t)) 4113 ;; level of current or previous header 4114 (setq level (markdown-outline-level)) 4115 ;; match group 1 indicates a setext header 4116 (setq setext (match-end 1)))) 4117 ;; check prefix argument 4118 (cond 4119 ((and (equal arg '(4)) level (> level 1)) ;; C-u 4120 (cl-decf level)) 4121 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u 4122 (cl-incf level)) 4123 (arg ;; numeric prefix 4124 (setq level (prefix-numeric-value arg)))) 4125 ;; setext headers must be level one or two 4126 (and level (setq setext (and setext (<= level 2)))) 4127 ;; insert the heading 4128 (markdown-insert-header level nil setext))) 4129 4130 (defun markdown-insert-header-setext-dwim (&optional arg) 4131 "Insert or replace header markup, with preference for setext. 4132 See `markdown-insert-header-dwim' for details, including how ARG is handled." 4133 (interactive "*P") 4134 (markdown-insert-header-dwim arg t)) 4135 4136 (defun markdown-insert-header-atx-1 () 4137 "Insert a first level atx-style (hash mark) header. 4138 See `markdown-insert-header'." 4139 (interactive "*") 4140 (markdown-insert-header 1 nil nil)) 4141 4142 (defun markdown-insert-header-atx-2 () 4143 "Insert a level two atx-style (hash mark) header. 4144 See `markdown-insert-header'." 4145 (interactive "*") 4146 (markdown-insert-header 2 nil nil)) 4147 4148 (defun markdown-insert-header-atx-3 () 4149 "Insert a level three atx-style (hash mark) header. 4150 See `markdown-insert-header'." 4151 (interactive "*") 4152 (markdown-insert-header 3 nil nil)) 4153 4154 (defun markdown-insert-header-atx-4 () 4155 "Insert a level four atx-style (hash mark) header. 4156 See `markdown-insert-header'." 4157 (interactive "*") 4158 (markdown-insert-header 4 nil nil)) 4159 4160 (defun markdown-insert-header-atx-5 () 4161 "Insert a level five atx-style (hash mark) header. 4162 See `markdown-insert-header'." 4163 (interactive "*") 4164 (markdown-insert-header 5 nil nil)) 4165 4166 (defun markdown-insert-header-atx-6 () 4167 "Insert a sixth level atx-style (hash mark) header. 4168 See `markdown-insert-header'." 4169 (interactive "*") 4170 (markdown-insert-header 6 nil nil)) 4171 4172 (defun markdown-insert-header-setext-1 () 4173 "Insert a setext-style (underlined) first-level header. 4174 See `markdown-insert-header'." 4175 (interactive "*") 4176 (markdown-insert-header 1 nil t)) 4177 4178 (defun markdown-insert-header-setext-2 () 4179 "Insert a setext-style (underlined) second-level header. 4180 See `markdown-insert-header'." 4181 (interactive "*") 4182 (markdown-insert-header 2 nil t)) 4183 4184 (defun markdown-blockquote-indentation (loc) 4185 "Return string containing necessary indentation for a blockquote at LOC. 4186 Also see `markdown-pre-indentation'." 4187 (save-excursion 4188 (goto-char loc) 4189 (let* ((list-level (length (markdown-calculate-list-levels))) 4190 (indent "")) 4191 (dotimes (_ list-level indent) 4192 (setq indent (concat indent " ")))))) 4193 4194 (defun markdown-insert-blockquote () 4195 "Start a blockquote section (or blockquote the region). 4196 If Transient Mark mode is on and a region is active, it is used as 4197 the blockquote text." 4198 (interactive) 4199 (if (use-region-p) 4200 (markdown-blockquote-region (region-beginning) (region-end)) 4201 (markdown-ensure-blank-line-before) 4202 (insert (markdown-blockquote-indentation (point)) "> ") 4203 (markdown-ensure-blank-line-after))) 4204 4205 (defun markdown-block-region (beg end prefix) 4206 "Format the region using a block prefix. 4207 Arguments BEG and END specify the beginning and end of the 4208 region. The characters PREFIX will appear at the beginning 4209 of each line." 4210 (save-excursion 4211 (let* ((end-marker (make-marker)) 4212 (beg-marker (make-marker)) 4213 (prefix-without-trailing-whitespace 4214 (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) 4215 ;; Ensure blank line after and remove extra whitespace 4216 (goto-char end) 4217 (skip-syntax-backward "-") 4218 (set-marker end-marker (point)) 4219 (delete-horizontal-space) 4220 (markdown-ensure-blank-line-after) 4221 ;; Ensure blank line before and remove extra whitespace 4222 (goto-char beg) 4223 (skip-syntax-forward "-") 4224 (delete-horizontal-space) 4225 (markdown-ensure-blank-line-before) 4226 (set-marker beg-marker (point)) 4227 ;; Insert PREFIX before each line 4228 (goto-char beg-marker) 4229 (while (and (< (line-beginning-position) end-marker) 4230 (not (eobp))) 4231 ;; Don’t insert trailing whitespace. 4232 (insert (if (eolp) prefix-without-trailing-whitespace prefix)) 4233 (forward-line))))) 4234 4235 (defun markdown-blockquote-region (beg end) 4236 "Blockquote the region. 4237 Arguments BEG and END specify the beginning and end of the region." 4238 (interactive "*r") 4239 (markdown-block-region 4240 beg end (concat (markdown-blockquote-indentation 4241 (max (point-min) (1- beg))) "> "))) 4242 4243 (defun markdown-pre-indentation (loc) 4244 "Return string containing necessary whitespace for a pre block at LOC. 4245 Also see `markdown-blockquote-indentation'." 4246 (save-excursion 4247 (goto-char loc) 4248 (let* ((list-level (length (markdown-calculate-list-levels))) 4249 indent) 4250 (dotimes (_ (1+ list-level) indent) 4251 (setq indent (concat indent " ")))))) 4252 4253 (defun markdown-insert-pre () 4254 "Start a preformatted section (or apply to the region). 4255 If Transient Mark mode is on and a region is active, it is marked 4256 as preformatted text." 4257 (interactive) 4258 (if (use-region-p) 4259 (markdown-pre-region (region-beginning) (region-end)) 4260 (markdown-ensure-blank-line-before) 4261 (insert (markdown-pre-indentation (point))) 4262 (markdown-ensure-blank-line-after))) 4263 4264 (defun markdown-pre-region (beg end) 4265 "Format the region as preformatted text. 4266 Arguments BEG and END specify the beginning and end of the region." 4267 (interactive "*r") 4268 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) 4269 (markdown-block-region beg end indent))) 4270 4271 (defun markdown-electric-backquote (arg) 4272 "Insert a backquote. 4273 The numeric prefix argument ARG says how many times to repeat the insertion. 4274 Call `markdown-insert-gfm-code-block' interactively 4275 if three backquotes inserted at the beginning of line." 4276 (interactive "*P") 4277 (self-insert-command (prefix-numeric-value arg)) 4278 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) 4279 (replace-match "") 4280 (call-interactively #'markdown-insert-gfm-code-block))) 4281 4282 (defconst markdown-gfm-recognized-languages 4283 ;; To reproduce/update, evaluate the let-form in 4284 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, 4285 ;; but with appropriate use of a keyboard macro, indenting and filling it 4286 ;; properly is pretty fast. 4287 '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR" 4288 "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada" 4289 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" 4290 "AngelScript" "Ant-Build-System" "ApacheConf" "Apex" 4291 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly" 4292 "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile" 4293 "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax" 4294 "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump" 4295 "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb" 4296 "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK" 4297 "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates" 4298 "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript" 4299 "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language" 4300 "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound" 4301 "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump" 4302 "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch" 4303 "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript" 4304 "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild" 4305 "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" 4306 "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" 4307 "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth" 4308 "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS" 4309 "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" 4310 "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" 4311 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config" 4312 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu" 4313 "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL" 4314 "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML" 4315 "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" 4316 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC" 4317 "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7" 4318 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON" 4319 "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java" 4320 "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison" 4321 "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout" 4322 "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE" 4323 "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex" 4324 "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid" 4325 "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" 4326 "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB" 4327 "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako" 4328 "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki" 4329 "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah" 4330 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode" 4331 "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL" 4332 "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" 4333 "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml" 4334 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C" 4335 "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal" 4336 "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript" 4337 "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox" 4338 "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus" 4339 "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn" 4340 "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod" 4341 "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell" 4342 "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer" 4343 "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python" 4344 "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc" 4345 "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket" 4346 "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol" 4347 "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript" 4348 "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage" 4349 "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL" 4350 "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" 4351 "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession" 4352 "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity" 4353 "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark" 4354 "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift" 4355 "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh" 4356 "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle" 4357 "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset" 4358 "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL" 4359 "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue" 4360 "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly" 4361 "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok" 4362 "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap" 4363 "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS" 4364 "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL" 4365 "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors" 4366 "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" 4367 "reStructuredText" "sed" "wdl" "wisp" "xBase") 4368 "Language specifiers recognized by GitHub's syntax highlighting features.") 4369 4370 (defvar-local markdown-gfm-used-languages nil 4371 "Language names used in GFM code blocks.") 4372 4373 (defun markdown-trim-whitespace (str) 4374 (replace-regexp-in-string 4375 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) 4376 4377 (defun markdown-clean-language-string (str) 4378 (replace-regexp-in-string 4379 "{\\.?\\|}" "" (markdown-trim-whitespace str))) 4380 4381 (defun markdown-validate-language-string (widget) 4382 (let ((str (widget-value widget))) 4383 (unless (string= str (markdown-clean-language-string str)) 4384 (widget-put widget :error (format "Invalid language spec: '%s'" str)) 4385 widget))) 4386 4387 (defun markdown-gfm-get-corpus () 4388 "Create corpus of recognized GFM code block languages for the given buffer." 4389 (let ((given-corpus (append markdown-gfm-additional-languages 4390 markdown-gfm-recognized-languages))) 4391 (append 4392 markdown-gfm-used-languages 4393 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) 4394 given-corpus)))) 4395 4396 (defun markdown-gfm-add-used-language (lang) 4397 "Clean LANG and add to list of used languages." 4398 (setq markdown-gfm-used-languages 4399 (cons lang (remove lang markdown-gfm-used-languages)))) 4400 4401 (defcustom markdown-spaces-after-code-fence 1 4402 "Number of space characters to insert after a code fence. 4403 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an 4404 opening code fence and an info string." 4405 :group 'markdown 4406 :type 'integer 4407 :safe #'natnump 4408 :package-version '(markdown-mode . "2.3")) 4409 4410 (defcustom markdown-code-block-braces nil 4411 "When non-nil, automatically insert braces for GFM code blocks." 4412 :group 'markdown 4413 :type 'boolean) 4414 4415 (defun markdown-insert-gfm-code-block (&optional lang edit) 4416 "Insert GFM code block for language LANG. 4417 If LANG is nil, the language will be queried from user. If a 4418 region is active, wrap this region with the markup instead. If 4419 the region boundaries are not on empty lines, these are added 4420 automatically in order to have the correct markup. When EDIT is 4421 non-nil (e.g., when \\[universal-argument] is given), edit the 4422 code block in an indirect buffer after insertion." 4423 (interactive 4424 (list (let ((completion-ignore-case nil)) 4425 (condition-case nil 4426 (markdown-clean-language-string 4427 (completing-read 4428 "Programming language: " 4429 (markdown-gfm-get-corpus) 4430 nil 'confirm (car markdown-gfm-used-languages) 4431 'markdown-gfm-language-history)) 4432 (quit ""))) 4433 current-prefix-arg)) 4434 (unless (string= lang "") (markdown-gfm-add-used-language lang)) 4435 (when (and (> (length lang) 0) 4436 (not markdown-code-block-braces)) 4437 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) 4438 lang))) 4439 (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) 4440 (gfm-close-brace (if markdown-code-block-braces "}" ""))) 4441 (if (use-region-p) 4442 (let* ((b (region-beginning)) (e (region-end)) end 4443 (indent (progn (goto-char b) (current-indentation)))) 4444 (goto-char e) 4445 ;; if we're on a blank line, don't newline, otherwise the ``` 4446 ;; should go on its own line 4447 (unless (looking-back "\n" nil) 4448 (newline)) 4449 (indent-to indent) 4450 (insert "```") 4451 (markdown-ensure-blank-line-after) 4452 (setq end (point)) 4453 (goto-char b) 4454 ;; if we're on a blank line, insert the quotes here, otherwise 4455 ;; add a new line first 4456 (unless (looking-at-p "\n") 4457 (newline) 4458 (forward-line -1)) 4459 (markdown-ensure-blank-line-before) 4460 (indent-to indent) 4461 (insert "```" gfm-open-brace lang gfm-close-brace) 4462 (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end)) 4463 (let ((indent (current-indentation)) 4464 start-bol) 4465 (delete-horizontal-space :backward-only) 4466 (markdown-ensure-blank-line-before) 4467 (indent-to indent) 4468 (setq start-bol (point-at-bol)) 4469 (insert "```" gfm-open-brace lang gfm-close-brace "\n") 4470 (indent-to indent) 4471 (unless edit (insert ?\n)) 4472 (indent-to indent) 4473 (insert "```") 4474 (markdown-ensure-blank-line-after) 4475 (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) 4476 (end-of-line 0) 4477 (when edit (markdown-edit-code-block))))) 4478 4479 (defun markdown-code-block-lang (&optional pos-prop) 4480 "Return the language name for a GFM or tilde fenced code block. 4481 The beginning of the block may be described by POS-PROP, 4482 a cons of (pos . prop) giving the position and property 4483 at the beginning of the block." 4484 (or pos-prop 4485 (setq pos-prop 4486 (markdown-max-of-seq 4487 #'car 4488 (cl-remove-if 4489 #'null 4490 (cl-mapcar 4491 #'markdown-find-previous-prop 4492 (markdown-get-fenced-block-begin-properties)))))) 4493 (when pos-prop 4494 (goto-char (car pos-prop)) 4495 (set-match-data (get-text-property (point) (cdr pos-prop))) 4496 ;; Note: Hard-coded group number assumes tilde 4497 ;; and GFM fenced code regexp groups agree. 4498 (let ((begin (match-beginning 3)) 4499 (end (match-end 3))) 4500 (when (and begin end) 4501 ;; Fix language strings beginning with periods, like ".ruby". 4502 (when (eq (char-after begin) ?.) 4503 (setq begin (1+ begin))) 4504 (buffer-substring-no-properties begin end))))) 4505 4506 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer) 4507 (with-current-buffer (or buffer (current-buffer)) 4508 (save-excursion 4509 (goto-char (point-min)) 4510 (cl-loop 4511 with prop = 'markdown-gfm-block-begin 4512 for pos-prop = (markdown-find-next-prop prop) 4513 while pos-prop 4514 for lang = (markdown-code-block-lang pos-prop) 4515 do (progn (when lang (markdown-gfm-add-used-language lang)) 4516 (goto-char (next-single-property-change (point) prop))))))) 4517 4518 (defun markdown-insert-foldable-block () 4519 "Insert details disclosure element to make content foldable. 4520 If a region is active, wrap this region with the disclosure 4521 element. More detais here 'https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details'." 4522 (interactive) 4523 (let ((details-open-tag "<details>") 4524 (details-close-tag "</details>") 4525 (summary-open-tag "<summary>") 4526 (summary-close-tag " </summary>")) 4527 (if (use-region-p) 4528 (let* ((b (region-beginning)) 4529 (e (region-end)) 4530 (indent (progn (goto-char b) (current-indentation)))) 4531 (goto-char e) 4532 ;; if we're on a blank line, don't newline, otherwise the tags 4533 ;; should go on its own line 4534 (unless (looking-back "\n" nil) 4535 (newline)) 4536 (indent-to indent) 4537 (insert details-close-tag) 4538 (markdown-ensure-blank-line-after) 4539 (goto-char b) 4540 ;; if we're on a blank line, insert the quotes here, otherwise 4541 ;; add a new line first 4542 (unless (looking-at-p "\n") 4543 (newline) 4544 (forward-line -1)) 4545 (markdown-ensure-blank-line-before) 4546 (indent-to indent) 4547 (insert details-open-tag "\n") 4548 (insert summary-open-tag summary-close-tag) 4549 (search-backward summary-close-tag)) 4550 (let ((indent (current-indentation))) 4551 (delete-horizontal-space :backward-only) 4552 (markdown-ensure-blank-line-before) 4553 (indent-to indent) 4554 (insert details-open-tag "\n") 4555 (insert summary-open-tag summary-close-tag "\n") 4556 (insert details-close-tag) 4557 (indent-to indent) 4558 (markdown-ensure-blank-line-after) 4559 (search-backward summary-close-tag))))) 4560 4561 4562 ;;; Footnotes ================================================================= 4563 4564 (defun markdown-footnote-counter-inc () 4565 "Increment `markdown-footnote-counter' and return the new value." 4566 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. 4567 (save-excursion 4568 (goto-char (point-min)) 4569 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") 4570 (point-max) t) 4571 (let ((fn (string-to-number (match-string 1)))) 4572 (when (> fn markdown-footnote-counter) 4573 (setq markdown-footnote-counter fn)))))) 4574 (cl-incf markdown-footnote-counter)) 4575 4576 (defun markdown-insert-footnote () 4577 "Insert footnote with a new number and move point to footnote definition." 4578 (interactive) 4579 (let ((fn (markdown-footnote-counter-inc))) 4580 (insert (format "[^%d]" fn)) 4581 (markdown-footnote-text-find-new-location) 4582 (markdown-ensure-blank-line-before) 4583 (unless (markdown-cur-line-blank-p) 4584 (insert "\n")) 4585 (insert (format "[^%d]: " fn)) 4586 (markdown-ensure-blank-line-after))) 4587 4588 (defun markdown-footnote-text-find-new-location () 4589 "Position the point at the proper location for a new footnote text." 4590 (cond 4591 ((eq markdown-footnote-location 'end) (goto-char (point-max))) 4592 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) 4593 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) 4594 ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) 4595 4596 (defun markdown-footnote-kill () 4597 "Kill the footnote at point. 4598 The footnote text is killed (and added to the kill ring), the 4599 footnote marker is deleted. Point has to be either at the 4600 footnote marker or in the footnote text." 4601 (interactive) 4602 (let ((marker-pos nil) 4603 (skip-deleting-marker nil) 4604 (starting-footnote-text-positions 4605 (markdown-footnote-text-positions))) 4606 (when starting-footnote-text-positions 4607 ;; We're starting in footnote text, so mark our return position and jump 4608 ;; to the marker if possible. 4609 (let ((marker-pos (markdown-footnote-find-marker 4610 (cl-first starting-footnote-text-positions)))) 4611 (if marker-pos 4612 (goto-char (1- marker-pos)) 4613 ;; If there isn't a marker, we still want to kill the text. 4614 (setq skip-deleting-marker t)))) 4615 ;; Either we didn't start in the text, or we started in the text and jumped 4616 ;; to the marker. We want to assume we're at the marker now and error if 4617 ;; we're not. 4618 (unless skip-deleting-marker 4619 (let ((marker (markdown-footnote-delete-marker))) 4620 (unless marker 4621 (error "Not at a footnote")) 4622 ;; Even if we knew the text position before, it changed when we deleted 4623 ;; the label. 4624 (setq marker-pos (cl-second marker)) 4625 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) 4626 (unless new-text-pos 4627 (error "No text for footnote `%s'" (cl-first marker))) 4628 (goto-char new-text-pos)))) 4629 (let ((pos (markdown-footnote-kill-text))) 4630 (goto-char (if starting-footnote-text-positions 4631 pos 4632 marker-pos))))) 4633 4634 (defun markdown-footnote-delete-marker () 4635 "Delete a footnote marker at point. 4636 Returns a list (ID START) containing the footnote ID and the 4637 start position of the marker before deletion. If no footnote 4638 marker was deleted, this function returns NIL." 4639 (let ((marker (markdown-footnote-marker-positions))) 4640 (when marker 4641 (delete-region (cl-second marker) (cl-third marker)) 4642 (butlast marker)))) 4643 4644 (defun markdown-footnote-kill-text () 4645 "Kill footnote text at point. 4646 Returns the start position of the footnote text before deletion, 4647 or NIL if point was not inside a footnote text. 4648 4649 The killed text is placed in the kill ring (without the footnote 4650 number)." 4651 (let ((fn (markdown-footnote-text-positions))) 4652 (when fn 4653 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) 4654 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) 4655 (kill-new (match-string 1 text)) 4656 (when (and (markdown-cur-line-blank-p) 4657 (markdown-prev-line-blank-p) 4658 (not (bobp))) 4659 (delete-region (1- (point)) (point))) 4660 (cl-second fn))))) 4661 4662 (defun markdown-footnote-goto-text () 4663 "Jump to the text of the footnote at point." 4664 (interactive) 4665 (let ((fn (car (markdown-footnote-marker-positions)))) 4666 (unless fn 4667 (user-error "Not at a footnote marker")) 4668 (let ((new-pos (markdown-footnote-find-text fn))) 4669 (unless new-pos 4670 (error "No definition found for footnote `%s'" fn)) 4671 (goto-char new-pos)))) 4672 4673 (defun markdown-footnote-return () 4674 "Return from a footnote to its footnote number in the main text." 4675 (interactive) 4676 (let ((fn (save-excursion 4677 (car (markdown-footnote-text-positions))))) 4678 (unless fn 4679 (user-error "Not in a footnote")) 4680 (let ((new-pos (markdown-footnote-find-marker fn))) 4681 (unless new-pos 4682 (error "Footnote marker `%s' not found" fn)) 4683 (goto-char new-pos)))) 4684 4685 (defun markdown-footnote-find-marker (id) 4686 "Find the location of the footnote marker with ID. 4687 The actual buffer position returned is the position directly 4688 following the marker's closing bracket. If no marker is found, 4689 NIL is returned." 4690 (save-excursion 4691 (goto-char (point-min)) 4692 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) 4693 (skip-chars-backward "^]") 4694 (point)))) 4695 4696 (defun markdown-footnote-find-text (id) 4697 "Find the location of the text of footnote ID. 4698 The actual buffer position returned is the position of the first 4699 character of the text, after the footnote's identifier. If no 4700 footnote text is found, NIL is returned." 4701 (save-excursion 4702 (goto-char (point-min)) 4703 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) 4704 (skip-chars-forward "[ \t]") 4705 (point)))) 4706 4707 (defun markdown-footnote-marker-positions () 4708 "Return the position and ID of the footnote marker point is on. 4709 The return value is a list (ID START END). If point is not on a 4710 footnote, NIL is returned." 4711 ;; first make sure we're at a footnote marker 4712 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) 4713 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) 4714 (save-excursion 4715 ;; move point between [ and ^: 4716 (if (looking-at-p "\\[") 4717 (forward-char 1) 4718 (skip-chars-backward "^[")) 4719 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) 4720 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) 4721 4722 (defun markdown-footnote-text-positions () 4723 "Return the start and end positions of the footnote text point is in. 4724 The exact return value is a list of three elements: (ID START END). 4725 The start position is the position of the opening bracket 4726 of the footnote id. The end position is directly after the 4727 newline that ends the footnote. If point is not in a footnote, 4728 NIL is returned instead." 4729 (save-excursion 4730 (let (result) 4731 (move-beginning-of-line 1) 4732 ;; Try to find the label. If we haven't found the label and we're at a blank 4733 ;; or indented line, back up if possible. 4734 (while (and 4735 (not (and (looking-at markdown-regex-footnote-definition) 4736 (setq result (list (match-string 1) (point))))) 4737 (and (not (bobp)) 4738 (or (markdown-cur-line-blank-p) 4739 (>= (current-indentation) 4)))) 4740 (forward-line -1)) 4741 (when result 4742 ;; Advance if there is a next line that is either blank or indented. 4743 ;; (Need to check if we're on the last line, because 4744 ;; markdown-next-line-blank-p returns true for last line in buffer.) 4745 (while (and (/= (line-end-position) (point-max)) 4746 (or (markdown-next-line-blank-p) 4747 (>= (markdown-next-line-indent) 4))) 4748 (forward-line)) 4749 ;; Move back while the current line is blank. 4750 (while (markdown-cur-line-blank-p) 4751 (forward-line -1)) 4752 ;; Advance to capture this line and a single trailing newline (if there 4753 ;; is one). 4754 (forward-line) 4755 (append result (list (point))))))) 4756 4757 (defun markdown-get-defined-footnotes () 4758 "Return a list of all defined footnotes. 4759 Result is an alist of pairs (MARKER . LINE), where MARKER is the 4760 footnote marker, a string, and LINE is the line number containing 4761 the footnote definition. 4762 4763 For example, suppose the following footnotes are defined at positions 4764 448 and 475: 4765 4766 \[^1]: First footnote here. 4767 \[^marker]: Second footnote. 4768 4769 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" 4770 (save-excursion 4771 (goto-char (point-min)) 4772 (let (footnotes) 4773 (while (markdown-search-until-condition 4774 (lambda () (and (not (markdown-code-block-at-point-p)) 4775 (not (markdown-inline-code-at-point-p)) 4776 (not (markdown-in-comment-p)))) 4777 markdown-regex-footnote-definition nil t) 4778 (let ((marker (match-string-no-properties 1)) 4779 (pos (match-beginning 0))) 4780 (unless (zerop (length marker)) 4781 (cl-pushnew (cons marker pos) footnotes :test #'equal)))) 4782 (reverse footnotes)))) 4783 4784 4785 ;;; Element Removal =========================================================== 4786 4787 (defun markdown-kill-thing-at-point () 4788 "Kill thing at point and add important text, without markup, to kill ring. 4789 Possible things to kill include (roughly in order of precedence): 4790 inline code, headers, horizontal rules, links (add link text to 4791 kill ring), images (add alt text to kill ring), angle uri, email 4792 addresses, bold, italics, reference definition (add URI to kill 4793 ring), footnote markers and text (kill both marker and text, add 4794 text to kill ring), and list items." 4795 (interactive "*") 4796 (let (val) 4797 (cond 4798 ;; Inline code 4799 ((markdown-inline-code-at-point) 4800 (kill-new (match-string 2)) 4801 (delete-region (match-beginning 0) (match-end 0))) 4802 ;; ATX header 4803 ((thing-at-point-looking-at markdown-regex-header-atx) 4804 (kill-new (match-string 2)) 4805 (delete-region (match-beginning 0) (match-end 0))) 4806 ;; Setext header 4807 ((thing-at-point-looking-at markdown-regex-header-setext) 4808 (kill-new (match-string 1)) 4809 (delete-region (match-beginning 0) (match-end 0))) 4810 ;; Horizontal rule 4811 ((thing-at-point-looking-at markdown-regex-hr) 4812 (kill-new (match-string 0)) 4813 (delete-region (match-beginning 0) (match-end 0))) 4814 ;; Inline link or image (add link or alt text to kill ring) 4815 ((thing-at-point-looking-at markdown-regex-link-inline) 4816 (kill-new (match-string 3)) 4817 (delete-region (match-beginning 0) (match-end 0))) 4818 ;; Reference link or image (add link or alt text to kill ring) 4819 ((thing-at-point-looking-at markdown-regex-link-reference) 4820 (kill-new (match-string 3)) 4821 (delete-region (match-beginning 0) (match-end 0))) 4822 ;; Angle URI (add URL to kill ring) 4823 ((thing-at-point-looking-at markdown-regex-angle-uri) 4824 (kill-new (match-string 2)) 4825 (delete-region (match-beginning 0) (match-end 0))) 4826 ;; Email address in angle brackets (add email address to kill ring) 4827 ((thing-at-point-looking-at markdown-regex-email) 4828 (kill-new (match-string 1)) 4829 (delete-region (match-beginning 0) (match-end 0))) 4830 ;; Wiki link (add alias text to kill ring) 4831 ((and markdown-enable-wiki-links 4832 (thing-at-point-looking-at markdown-regex-wiki-link)) 4833 (kill-new (markdown-wiki-link-alias)) 4834 (delete-region (match-beginning 1) (match-end 1))) 4835 ;; Bold 4836 ((thing-at-point-looking-at markdown-regex-bold) 4837 (kill-new (match-string 4)) 4838 (delete-region (match-beginning 2) (match-end 2))) 4839 ;; Italics 4840 ((thing-at-point-looking-at markdown-regex-italic) 4841 (kill-new (match-string 3)) 4842 (delete-region (match-beginning 1) (match-end 1))) 4843 ;; Strikethrough 4844 ((thing-at-point-looking-at markdown-regex-strike-through) 4845 (kill-new (match-string 4)) 4846 (delete-region (match-beginning 2) (match-end 2))) 4847 ;; Footnote marker (add footnote text to kill ring) 4848 ((thing-at-point-looking-at markdown-regex-footnote) 4849 (markdown-footnote-kill)) 4850 ;; Footnote text (add footnote text to kill ring) 4851 ((setq val (markdown-footnote-text-positions)) 4852 (markdown-footnote-kill)) 4853 ;; Reference definition (add URL to kill ring) 4854 ((thing-at-point-looking-at markdown-regex-reference-definition) 4855 (kill-new (match-string 5)) 4856 (delete-region (match-beginning 0) (match-end 0))) 4857 ;; List item 4858 ((setq val (markdown-cur-list-item-bounds)) 4859 (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) 4860 (t 4861 (user-error "Nothing found at point to kill"))))) 4862 4863 (defun markdown-kill-outline () 4864 "Kill visible heading and add it to `kill-ring'." 4865 (interactive) 4866 (save-excursion 4867 (markdown-outline-previous) 4868 (kill-region (point) (progn (markdown-outline-next) (point))))) 4869 4870 (defun markdown-kill-block () 4871 "Kill visible code block, list item, or blockquote and add it to `kill-ring'." 4872 (interactive) 4873 (save-excursion 4874 (markdown-backward-block) 4875 (kill-region (point) (progn (markdown-forward-block) (point))))) 4876 4877 4878 ;;; Indentation =============================================================== 4879 4880 (defun markdown-indent-find-next-position (cur-pos positions) 4881 "Return the position after the index of CUR-POS in POSITIONS. 4882 Positions are calculated by `markdown-calc-indents'." 4883 (while (and positions 4884 (not (equal cur-pos (car positions)))) 4885 (setq positions (cdr positions))) 4886 (or (cadr positions) 0)) 4887 4888 (defun markdown-outdent-find-next-position (cur-pos positions) 4889 "Return the maximal element that precedes CUR-POS from POSITIONS. 4890 Positions are calculated by `markdown-calc-indents'." 4891 (let ((result 0)) 4892 (dolist (i positions) 4893 (when (< i cur-pos) 4894 (setq result (max result i)))) 4895 result)) 4896 4897 (defun markdown-indent-line () 4898 "Indent the current line using some heuristics. 4899 If the _previous_ command was either `markdown-enter-key' or 4900 `markdown-cycle', then we should cycle to the next 4901 reasonable indentation position. Otherwise, we could have been 4902 called directly by `markdown-enter-key', by an initial call of 4903 `markdown-cycle', or indirectly by `auto-fill-mode'. In 4904 these cases, indent to the default position. 4905 Positions are calculated by `markdown-calc-indents'." 4906 (interactive) 4907 (let ((positions (markdown-calc-indents)) 4908 (point-pos (current-column)) 4909 (_ (back-to-indentation)) 4910 (cur-pos (current-column))) 4911 (if (not (equal this-command 'markdown-cycle)) 4912 (indent-line-to (car positions)) 4913 (setq positions (sort (delete-dups positions) '<)) 4914 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) 4915 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) 4916 (indent-line-to next-pos) 4917 (move-to-column new-point-pos))))) 4918 4919 (defun markdown-calc-indents () 4920 "Return a list of indentation columns to cycle through. 4921 The first element in the returned list should be considered the 4922 default indentation level. This function does not worry about 4923 duplicate positions, which are handled up by calling functions." 4924 (let (pos prev-line-pos positions) 4925 4926 ;; Indentation of previous line 4927 (setq prev-line-pos (markdown-prev-line-indent)) 4928 (setq positions (cons prev-line-pos positions)) 4929 4930 ;; Indentation of previous non-list-marker text 4931 (when (setq pos (save-excursion 4932 (forward-line -1) 4933 (when (looking-at markdown-regex-list) 4934 (- (match-end 3) (match-beginning 0))))) 4935 (setq positions (cons pos positions))) 4936 4937 ;; Indentation required for a pre block in current context 4938 (setq pos (length (markdown-pre-indentation (point)))) 4939 (setq positions (cons pos positions)) 4940 4941 ;; Indentation of the previous line + tab-width 4942 (if prev-line-pos 4943 (setq positions (cons (+ prev-line-pos tab-width) positions)) 4944 (setq positions (cons tab-width positions))) 4945 4946 ;; Indentation of the previous line - tab-width 4947 (if (and prev-line-pos (> prev-line-pos tab-width)) 4948 (setq positions (cons (- prev-line-pos tab-width) positions))) 4949 4950 ;; Indentation of all preceding list markers (when in a list) 4951 (when (setq pos (markdown-calculate-list-levels)) 4952 (setq positions (append pos positions))) 4953 4954 ;; First column 4955 (setq positions (cons 0 positions)) 4956 4957 ;; Return reversed list 4958 (reverse positions))) 4959 4960 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent 4961 "Handle RET depending on the context. 4962 If the point is at a table, move to the next row. Otherwise, 4963 indent according to value of `markdown-indent-on-enter'. 4964 When it is nil, simply call `newline'. Otherwise, indent the next line 4965 following RET using `markdown-indent-line'. Furthermore, when it 4966 is set to 'indent-and-new-item and the point is in a list item, 4967 start a new item with the same indentation. If the point is in an 4968 empty list item, remove it (so that pressing RET twice when in a 4969 list simply adds a blank line)." 4970 (interactive) 4971 (cond 4972 ;; Table 4973 ((markdown-table-at-point-p) 4974 (call-interactively #'markdown-table-next-row)) 4975 ;; Indent non-table text 4976 (markdown-indent-on-enter 4977 (let (bounds) 4978 (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) 4979 (setq bounds (markdown-cur-list-item-bounds))) 4980 (let ((beg (cl-first bounds)) 4981 (end (cl-second bounds)) 4982 (length (cl-fourth bounds))) 4983 ;; Point is in a list item 4984 (if (= (- end beg) length) 4985 ;; Delete blank list 4986 (progn 4987 (delete-region beg end) 4988 (newline) 4989 (markdown-indent-line)) 4990 (call-interactively #'markdown-insert-list-item))) 4991 ;; Point is not in a list 4992 (newline) 4993 (markdown-indent-line)))) 4994 ;; Insert a raw newline 4995 (t (newline)))) 4996 4997 (defun markdown-outdent-or-delete (arg) 4998 "Handle BACKSPACE by cycling through indentation points. 4999 When BACKSPACE is pressed, if there is only whitespace 5000 before the current point, then outdent the line one level. 5001 Otherwise, do normal delete by repeating 5002 `backward-delete-char-untabify' ARG times." 5003 (interactive "*p") 5004 (if (use-region-p) 5005 (backward-delete-char-untabify arg) 5006 (let ((cur-pos (current-column)) 5007 (start-of-indention (save-excursion 5008 (back-to-indentation) 5009 (current-column))) 5010 (positions (markdown-calc-indents))) 5011 (if (and (> cur-pos 0) (= cur-pos start-of-indention)) 5012 (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) 5013 (backward-delete-char-untabify arg))))) 5014 5015 (defun markdown-find-leftmost-column (beg end) 5016 "Find the leftmost column in the region from BEG to END." 5017 (let ((mincol 1000)) 5018 (save-excursion 5019 (goto-char beg) 5020 (while (< (point) end) 5021 (back-to-indentation) 5022 (unless (looking-at-p "[ \t]*$") 5023 (setq mincol (min mincol (current-column)))) 5024 (forward-line 1) 5025 )) 5026 mincol)) 5027 5028 (defun markdown-indent-region (beg end arg) 5029 "Indent the region from BEG to END using some heuristics. 5030 When ARG is non-nil, outdent the region instead. 5031 See `markdown-indent-line' and `markdown-indent-line'." 5032 (interactive "*r\nP") 5033 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) 5034 (leftmostcol (markdown-find-leftmost-column beg end)) 5035 (next-pos (if arg 5036 (markdown-outdent-find-next-position leftmostcol positions) 5037 (markdown-indent-find-next-position leftmostcol positions)))) 5038 (indent-rigidly beg end (- next-pos leftmostcol)) 5039 (setq deactivate-mark nil))) 5040 5041 (defun markdown-outdent-region (beg end) 5042 "Call `markdown-indent-region' on region from BEG to END with prefix." 5043 (interactive "*r") 5044 (markdown-indent-region beg end t)) 5045 5046 (defun markdown--indent-region (start end) 5047 (let ((deactivate-mark nil)) 5048 (save-excursion 5049 (goto-char end) 5050 (setq end (point-marker)) 5051 (goto-char start) 5052 (when (bolp) 5053 (forward-line 1)) 5054 (while (< (point) end) 5055 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) 5056 (indent-according-to-mode)) 5057 (forward-line 1)) 5058 (move-marker end nil)))) 5059 5060 5061 ;;; Markup Completion ========================================================= 5062 5063 (defconst markdown-complete-alist 5064 '((markdown-regex-header-atx . markdown-complete-atx) 5065 (markdown-regex-header-setext . markdown-complete-setext) 5066 (markdown-regex-hr . markdown-complete-hr)) 5067 "Association list of form (regexp . function) for markup completion.") 5068 5069 (defun markdown-incomplete-atx-p () 5070 "Return t if ATX header markup is incomplete and nil otherwise. 5071 Assumes match data is available for `markdown-regex-header-atx'. 5072 Checks that the number of trailing hash marks equals the number of leading 5073 hash marks, that there is only a single space before and after the text, 5074 and that there is no extraneous whitespace in the text." 5075 (or 5076 ;; Number of starting and ending hash marks differs 5077 (not (= (length (match-string 1)) (length (match-string 3)))) 5078 ;; When the header text is not empty... 5079 (and (> (length (match-string 2)) 0) 5080 ;; ...if there are extra leading, trailing, or interior spaces 5081 (or (not (= (match-beginning 2) (1+ (match-end 1)))) 5082 (not (= (match-beginning 3) (1+ (match-end 2)))) 5083 (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) 5084 ;; When the header text is empty... 5085 (and (= (length (match-string 2)) 0) 5086 ;; ...if there are too many or too few spaces 5087 (not (= (match-beginning 3) (+ (match-end 1) 2)))))) 5088 5089 (defun markdown-complete-atx () 5090 "Complete and normalize ATX headers. 5091 Add or remove hash marks to the end of the header to match the 5092 beginning. Ensure that there is only a single space between hash 5093 marks and header text. Removes extraneous whitespace from header text. 5094 Assumes match data is available for `markdown-regex-header-atx'. 5095 Return nil if markup was complete and non-nil if markup was completed." 5096 (when (markdown-incomplete-atx-p) 5097 (let* ((new-marker (make-marker)) 5098 (new-marker (set-marker new-marker (match-end 2)))) 5099 ;; Hash marks and spacing at end 5100 (goto-char (match-end 2)) 5101 (delete-region (match-end 2) (match-end 3)) 5102 (insert " " (match-string 1)) 5103 ;; Remove extraneous whitespace from title 5104 (replace-match (markdown-compress-whitespace-string (match-string 2)) 5105 t t nil 2) 5106 ;; Spacing at beginning 5107 (goto-char (match-end 1)) 5108 (delete-region (match-end 1) (match-beginning 2)) 5109 (insert " ") 5110 ;; Leave point at end of text 5111 (goto-char new-marker)))) 5112 5113 (defun markdown-incomplete-setext-p () 5114 "Return t if setext header markup is incomplete and nil otherwise. 5115 Assumes match data is available for `markdown-regex-header-setext'. 5116 Checks that length of underline matches text and that there is no 5117 extraneous whitespace in the text." 5118 (or (not (= (length (match-string 1)) (length (match-string 2)))) 5119 (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) 5120 5121 (defun markdown-complete-setext () 5122 "Complete and normalize setext headers. 5123 Add or remove underline characters to match length of header 5124 text. Removes extraneous whitespace from header text. Assumes 5125 match data is available for `markdown-regex-header-setext'. 5126 Return nil if markup was complete and non-nil if markup was completed." 5127 (when (markdown-incomplete-setext-p) 5128 (let* ((text (markdown-compress-whitespace-string (match-string 1))) 5129 (char (char-after (match-beginning 2))) 5130 (level (if (char-equal char ?-) 2 1))) 5131 (goto-char (match-beginning 0)) 5132 (delete-region (match-beginning 0) (match-end 0)) 5133 (markdown-insert-header level text t) 5134 t))) 5135 5136 (defun markdown-incomplete-hr-p () 5137 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. 5138 Assumes match data is available for `markdown-regex-hr'." 5139 (not (member (match-string 0) markdown-hr-strings))) 5140 5141 (defun markdown-complete-hr () 5142 "Complete horizontal rules. 5143 If horizontal rule string is a member of `markdown-hr-strings', 5144 do nothing. Otherwise, replace with the car of 5145 `markdown-hr-strings'. 5146 Assumes match data is available for `markdown-regex-hr'. 5147 Return nil if markup was complete and non-nil if markup was completed." 5148 (when (markdown-incomplete-hr-p) 5149 (replace-match (car markdown-hr-strings)) 5150 t)) 5151 5152 (defun markdown-complete () 5153 "Complete markup of object near point or in region when active. 5154 Handle all objects in `markdown-complete-alist', in order. 5155 See `markdown-complete-at-point' and `markdown-complete-region'." 5156 (interactive "*") 5157 (if (use-region-p) 5158 (markdown-complete-region (region-beginning) (region-end)) 5159 (markdown-complete-at-point))) 5160 5161 (defun markdown-complete-at-point () 5162 "Complete markup of object near point. 5163 Handle all elements of `markdown-complete-alist' in order." 5164 (interactive "*") 5165 (let ((list markdown-complete-alist) found changed) 5166 (while list 5167 (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? 5168 (function (cdar list))) 5169 (setq list (cdr list)) 5170 (when (thing-at-point-looking-at regexp) 5171 (setq found t) 5172 (setq changed (funcall function)) 5173 (setq list nil)))) 5174 (if found 5175 (or changed (user-error "Markup at point is complete")) 5176 (user-error "Nothing to complete at point")))) 5177 5178 (defun markdown-complete-region (beg end) 5179 "Complete markup of objects in region from BEG to END. 5180 Handle all objects in `markdown-complete-alist', in order. Each 5181 match is checked to ensure that a previous regexp does not also 5182 match." 5183 (interactive "*r") 5184 (let ((end-marker (set-marker (make-marker) end)) 5185 previous) 5186 (dolist (element markdown-complete-alist) 5187 (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? 5188 (function (cdr element))) 5189 (goto-char beg) 5190 (while (re-search-forward regexp end-marker 'limit) 5191 (when (match-string 0) 5192 ;; Make sure this is not a match for any of the preceding regexps. 5193 ;; This prevents mistaking an HR for a Setext subheading. 5194 (let (match) 5195 (save-match-data 5196 (dolist (prev-regexp previous) 5197 (or match (setq match (looking-back prev-regexp nil))))) 5198 (unless match 5199 (save-excursion (funcall function)))))) 5200 (cl-pushnew regexp previous :test #'equal))) 5201 previous)) 5202 5203 (defun markdown-complete-buffer () 5204 "Complete markup for all objects in the current buffer." 5205 (interactive "*") 5206 (markdown-complete-region (point-min) (point-max))) 5207 5208 5209 ;;; Markup Cycling ============================================================ 5210 5211 (defun markdown-cycle-atx (arg &optional remove) 5212 "Cycle ATX header markup. 5213 Promote header (decrease level) when ARG is 1 and demote 5214 header (increase level) if arg is -1. When REMOVE is non-nil, 5215 remove the header when the level reaches zero and stop cycling 5216 when it reaches six. Otherwise, perform a proper cycling through 5217 levels one through six. Assumes match data is available for 5218 `markdown-regex-header-atx'." 5219 (let* ((old-level (length (match-string 1))) 5220 (new-level (+ old-level arg)) 5221 (text (match-string 2))) 5222 (when (not remove) 5223 (setq new-level (% new-level 6)) 5224 (setq new-level (cond ((= new-level 0) 6) 5225 ((< new-level 0) (+ new-level 6)) 5226 (t new-level)))) 5227 (cond 5228 ((= new-level 0) 5229 (markdown-unwrap-thing-at-point nil 0 2)) 5230 ((<= new-level 6) 5231 (goto-char (match-beginning 0)) 5232 (delete-region (match-beginning 0) (match-end 0)) 5233 (markdown-insert-header new-level text nil))))) 5234 5235 (defun markdown-cycle-setext (arg &optional remove) 5236 "Cycle setext header markup. 5237 Promote header (increase level) when ARG is 1 and demote 5238 header (decrease level or remove) if arg is -1. When demoting a 5239 level-two setext header, replace with a level-three atx header. 5240 When REMOVE is non-nil, remove the header when the level reaches 5241 zero. Otherwise, cycle back to a level six atx header. Assumes 5242 match data is available for `markdown-regex-header-setext'." 5243 (let* ((char (char-after (match-beginning 2))) 5244 (old-level (if (char-equal char ?=) 1 2)) 5245 (new-level (+ old-level arg))) 5246 (when (and (not remove) (= new-level 0)) 5247 (setq new-level 6)) 5248 (cond 5249 ((= new-level 0) 5250 (markdown-unwrap-thing-at-point nil 0 1)) 5251 ((<= new-level 2) 5252 (markdown-insert-header new-level nil t)) 5253 ((<= new-level 6) 5254 (markdown-insert-header new-level nil nil))))) 5255 5256 (defun markdown-cycle-hr (arg &optional remove) 5257 "Cycle string used for horizontal rule from `markdown-hr-strings'. 5258 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle 5259 backwards (promote). When REMOVE is non-nil, remove the hr instead 5260 of cycling when the end of the list is reached. 5261 Assumes match data is available for `markdown-regex-hr'." 5262 (let* ((strings (if (= arg -1) 5263 (reverse markdown-hr-strings) 5264 markdown-hr-strings)) 5265 (tail (member (match-string 0) strings)) 5266 (new (or (cadr tail) 5267 (if remove 5268 (if (= arg 1) 5269 "" 5270 (car tail)) 5271 (car strings))))) 5272 (replace-match new))) 5273 5274 (defun markdown-cycle-bold () 5275 "Cycle bold markup between underscores and asterisks. 5276 Assumes match data is available for `markdown-regex-bold'." 5277 (save-excursion 5278 (let* ((old-delim (match-string 3)) 5279 (new-delim (if (string-equal old-delim "**") "__" "**"))) 5280 (replace-match new-delim t t nil 3) 5281 (replace-match new-delim t t nil 5)))) 5282 5283 (defun markdown-cycle-italic () 5284 "Cycle italic markup between underscores and asterisks. 5285 Assumes match data is available for `markdown-regex-italic'." 5286 (save-excursion 5287 (let* ((old-delim (match-string 2)) 5288 (new-delim (if (string-equal old-delim "*") "_" "*"))) 5289 (replace-match new-delim t t nil 2) 5290 (replace-match new-delim t t nil 4)))) 5291 5292 5293 ;;; Keymap ==================================================================== 5294 5295 (defun markdown--style-map-prompt () 5296 "Return a formatted prompt for Markdown markup insertion." 5297 (when markdown-enable-prefix-prompts 5298 (concat 5299 "Markdown: " 5300 (propertize "bold" 'face 'markdown-bold-face) ", " 5301 (propertize "italic" 'face 'markdown-italic-face) ", " 5302 (propertize "code" 'face 'markdown-inline-code-face) ", " 5303 (propertize "C = GFM code" 'face 'markdown-code-face) ", " 5304 (propertize "pre" 'face 'markdown-pre-face) ", " 5305 (propertize "footnote" 'face 'markdown-footnote-text-face) ", " 5306 (propertize "F = foldable" 'face 'markdown-bold-face) ", " 5307 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " 5308 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " 5309 (propertize "- = hr" 'face 'markdown-hr-face) ", " 5310 "C-h = more"))) 5311 5312 (defun markdown--command-map-prompt () 5313 "Return prompt for Markdown buffer-wide commands." 5314 (when markdown-enable-prefix-prompts 5315 (concat 5316 "Command: " 5317 (propertize "m" 'face 'markdown-bold-face) "arkdown, " 5318 (propertize "p" 'face 'markdown-bold-face) "review, " 5319 (propertize "o" 'face 'markdown-bold-face) "pen, " 5320 (propertize "e" 'face 'markdown-bold-face) "xport, " 5321 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " 5322 (propertize "c" 'face 'markdown-bold-face) "heck refs, " 5323 (propertize "u" 'face 'markdown-bold-face) "nused refs, " 5324 "C-h = more"))) 5325 5326 (defvar markdown-mode-style-map 5327 (let ((map (make-keymap (markdown--style-map-prompt)))) 5328 (define-key map (kbd "1") 'markdown-insert-header-atx-1) 5329 (define-key map (kbd "2") 'markdown-insert-header-atx-2) 5330 (define-key map (kbd "3") 'markdown-insert-header-atx-3) 5331 (define-key map (kbd "4") 'markdown-insert-header-atx-4) 5332 (define-key map (kbd "5") 'markdown-insert-header-atx-5) 5333 (define-key map (kbd "6") 'markdown-insert-header-atx-6) 5334 (define-key map (kbd "!") 'markdown-insert-header-setext-1) 5335 (define-key map (kbd "@") 'markdown-insert-header-setext-2) 5336 (define-key map (kbd "b") 'markdown-insert-bold) 5337 (define-key map (kbd "c") 'markdown-insert-code) 5338 (define-key map (kbd "C") 'markdown-insert-gfm-code-block) 5339 (define-key map (kbd "f") 'markdown-insert-footnote) 5340 (define-key map (kbd "F") 'markdown-insert-foldable-block) 5341 (define-key map (kbd "h") 'markdown-insert-header-dwim) 5342 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) 5343 (define-key map (kbd "i") 'markdown-insert-italic) 5344 (define-key map (kbd "k") 'markdown-insert-kbd) 5345 (define-key map (kbd "l") 'markdown-insert-link) 5346 (define-key map (kbd "p") 'markdown-insert-pre) 5347 (define-key map (kbd "P") 'markdown-pre-region) 5348 (define-key map (kbd "q") 'markdown-insert-blockquote) 5349 (define-key map (kbd "s") 'markdown-insert-strike-through) 5350 (define-key map (kbd "t") 'markdown-insert-table) 5351 (define-key map (kbd "Q") 'markdown-blockquote-region) 5352 (define-key map (kbd "w") 'markdown-insert-wiki-link) 5353 (define-key map (kbd "-") 'markdown-insert-hr) 5354 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) 5355 ;; Deprecated keys that may be removed in a future version 5356 (define-key map (kbd "e") 'markdown-insert-italic) 5357 map) 5358 "Keymap for Markdown text styling commands.") 5359 5360 (defvar markdown-mode-command-map 5361 (let ((map (make-keymap (markdown--command-map-prompt)))) 5362 (define-key map (kbd "m") 'markdown-other-window) 5363 (define-key map (kbd "p") 'markdown-preview) 5364 (define-key map (kbd "e") 'markdown-export) 5365 (define-key map (kbd "v") 'markdown-export-and-preview) 5366 (define-key map (kbd "o") 'markdown-open) 5367 (define-key map (kbd "l") 'markdown-live-preview-mode) 5368 (define-key map (kbd "w") 'markdown-kill-ring-save) 5369 (define-key map (kbd "c") 'markdown-check-refs) 5370 (define-key map (kbd "u") 'markdown-unused-refs) 5371 (define-key map (kbd "n") 'markdown-cleanup-list-numbers) 5372 (define-key map (kbd "]") 'markdown-complete-buffer) 5373 (define-key map (kbd "^") 'markdown-table-sort-lines) 5374 (define-key map (kbd "|") 'markdown-table-convert-region) 5375 (define-key map (kbd "t") 'markdown-table-transpose) 5376 map) 5377 "Keymap for Markdown buffer-wide commands.") 5378 5379 (defvar markdown-mode-map 5380 (let ((map (make-keymap))) 5381 ;; Markup insertion & removal 5382 (define-key map (kbd "C-c C-s") markdown-mode-style-map) 5383 (define-key map (kbd "C-c C-l") 'markdown-insert-link) 5384 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) 5385 ;; Promotion, demotion, and cycling 5386 (define-key map (kbd "C-c C--") 'markdown-promote) 5387 (define-key map (kbd "C-c C-=") 'markdown-demote) 5388 (define-key map (kbd "C-c C-]") 'markdown-complete) 5389 ;; Following and doing things 5390 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) 5391 (define-key map (kbd "C-c C-d") 'markdown-do) 5392 (define-key map (kbd "C-c '") 'markdown-edit-code-block) 5393 ;; Indentation 5394 (define-key map (kbd "RET") 'markdown-enter-key) 5395 (define-key map (kbd "DEL") 'markdown-outdent-or-delete) 5396 (define-key map (kbd "C-c >") 'markdown-indent-region) 5397 (define-key map (kbd "C-c <") 'markdown-outdent-region) 5398 ;; Visibility cycling 5399 (define-key map (kbd "TAB") 'markdown-cycle) 5400 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by 5401 ;; (local-)function-key-map. 5402 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) 5403 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) 5404 (define-key map (kbd "<backtab>") 'markdown-shifttab) 5405 ;; Heading and list navigation 5406 (define-key map (kbd "C-c C-n") 'markdown-outline-next) 5407 (define-key map (kbd "C-c C-p") 'markdown-outline-previous) 5408 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) 5409 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) 5410 (define-key map (kbd "C-c C-u") 'markdown-outline-up) 5411 ;; Buffer-wide commands 5412 (define-key map (kbd "C-c C-c") markdown-mode-command-map) 5413 ;; Subtree, list, and table editing 5414 (define-key map (kbd "C-c <up>") 'markdown-move-up) 5415 (define-key map (kbd "C-c <down>") 'markdown-move-down) 5416 (define-key map (kbd "C-c <left>") 'markdown-promote) 5417 (define-key map (kbd "C-c <right>") 'markdown-demote) 5418 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) 5419 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) 5420 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) 5421 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) 5422 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) 5423 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) 5424 (define-key map (kbd "M-RET") 'markdown-insert-list-item) 5425 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) 5426 ;; Paragraphs (Markdown context aware) 5427 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) 5428 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) 5429 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) 5430 ;; Blocks (one or more paragraphs) 5431 (define-key map (kbd "C-M-{") 'markdown-backward-block) 5432 (define-key map (kbd "C-M-}") 'markdown-forward-block) 5433 (define-key map (kbd "C-c M-h") 'markdown-mark-block) 5434 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) 5435 ;; Pages (top-level sections) 5436 (define-key map [remap backward-page] 'markdown-backward-page) 5437 (define-key map [remap forward-page] 'markdown-forward-page) 5438 (define-key map [remap mark-page] 'markdown-mark-page) 5439 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) 5440 ;; Link Movement 5441 (define-key map (kbd "M-n") 'markdown-next-link) 5442 (define-key map (kbd "M-p") 'markdown-previous-link) 5443 ;; Toggling functionality 5444 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) 5445 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) 5446 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) 5447 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) 5448 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) 5449 ;; Alternative keys (in case of problems with the arrow keys) 5450 (define-key map (kbd "C-c C-x u") 'markdown-move-up) 5451 (define-key map (kbd "C-c C-x d") 'markdown-move-down) 5452 (define-key map (kbd "C-c C-x l") 'markdown-promote) 5453 (define-key map (kbd "C-c C-x r") 'markdown-demote) 5454 ;; Deprecated keys that may be removed in a future version 5455 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l 5456 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l 5457 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l 5458 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l 5459 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) 5460 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) 5461 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) 5462 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) 5463 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) 5464 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) 5465 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) 5466 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) 5467 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) 5468 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) 5469 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) 5470 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) 5471 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) 5472 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) 5473 (define-key map (kbd "C-c C-i") 'markdown-insert-image) 5474 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j 5475 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d 5476 (define-key map (kbd "C-c -") 'markdown-insert-hr) 5477 map) 5478 "Keymap for Markdown major mode.") 5479 5480 (defvar markdown-mode-mouse-map 5481 (when markdown-mouse-follow-link 5482 (let ((map (make-sparse-keymap))) 5483 (define-key map [follow-link] 'mouse-face) 5484 (define-key map [mouse-2] #'markdown-follow-thing-at-point) 5485 map)) 5486 "Keymap for following links with mouse.") 5487 5488 (defvar gfm-mode-map 5489 (let ((map (make-sparse-keymap))) 5490 (set-keymap-parent map markdown-mode-map) 5491 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) 5492 (define-key map "`" 'markdown-electric-backquote) 5493 map) 5494 "Keymap for `gfm-mode'. 5495 See also `markdown-mode-map'.") 5496 5497 5498 ;;; Menu ====================================================================== 5499 5500 (easy-menu-define markdown-mode-menu markdown-mode-map 5501 "Menu for Markdown mode." 5502 '("Markdown" 5503 "---" 5504 ("Movement" 5505 ["Jump" markdown-do] 5506 ["Follow Link" markdown-follow-thing-at-point] 5507 ["Next Link" markdown-next-link] 5508 ["Previous Link" markdown-previous-link] 5509 "---" 5510 ["Next Heading or List Item" markdown-outline-next] 5511 ["Previous Heading or List Item" markdown-outline-previous] 5512 ["Next at Same Level" markdown-outline-next-same-level] 5513 ["Previous at Same Level" markdown-outline-previous-same-level] 5514 ["Up to Parent" markdown-outline-up] 5515 "---" 5516 ["Forward Paragraph" markdown-forward-paragraph] 5517 ["Backward Paragraph" markdown-backward-paragraph] 5518 ["Forward Block" markdown-forward-block] 5519 ["Backward Block" markdown-backward-block]) 5520 ("Show & Hide" 5521 ["Cycle Heading Visibility" markdown-cycle 5522 :enable (markdown-on-heading-p)] 5523 ["Cycle Heading Visibility (Global)" markdown-shifttab] 5524 "---" 5525 ["Narrow to Region" narrow-to-region] 5526 ["Narrow to Block" markdown-narrow-to-block] 5527 ["Narrow to Section" narrow-to-defun] 5528 ["Narrow to Subtree" markdown-narrow-to-subtree] 5529 ["Widen" widen (buffer-narrowed-p)] 5530 "---" 5531 ["Toggle Markup Hiding" markdown-toggle-markup-hiding 5532 :keys "C-c C-x C-m" 5533 :style radio 5534 :selected markdown-hide-markup]) 5535 "---" 5536 ("Headings & Structure" 5537 ["Automatic Heading" markdown-insert-header-dwim 5538 :keys "C-c C-s h"] 5539 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim 5540 :keys "C-c C-s H"] 5541 ("Specific Heading (atx)" 5542 ["First Level atx" markdown-insert-header-atx-1 5543 :keys "C-c C-s 1"] 5544 ["Second Level atx" markdown-insert-header-atx-2 5545 :keys "C-c C-s 2"] 5546 ["Third Level atx" markdown-insert-header-atx-3 5547 :keys "C-c C-s 3"] 5548 ["Fourth Level atx" markdown-insert-header-atx-4 5549 :keys "C-c C-s 4"] 5550 ["Fifth Level atx" markdown-insert-header-atx-5 5551 :keys "C-c C-s 5"] 5552 ["Sixth Level atx" markdown-insert-header-atx-6 5553 :keys "C-c C-s 6"]) 5554 ("Specific Heading (Setext)" 5555 ["First Level Setext" markdown-insert-header-setext-1 5556 :keys "C-c C-s !"] 5557 ["Second Level Setext" markdown-insert-header-setext-2 5558 :keys "C-c C-s @"]) 5559 ["Horizontal Rule" markdown-insert-hr 5560 :keys "C-c C-s -"] 5561 "---" 5562 ["Move Subtree Up" markdown-move-up 5563 :keys "C-c <up>"] 5564 ["Move Subtree Down" markdown-move-down 5565 :keys "C-c <down>"] 5566 ["Promote Subtree" markdown-promote 5567 :keys "C-c <left>"] 5568 ["Demote Subtree" markdown-demote 5569 :keys "C-c <right>"]) 5570 ("Region & Mark" 5571 ["Indent Region" markdown-indent-region] 5572 ["Outdent Region" markdown-outdent-region] 5573 "--" 5574 ["Mark Paragraph" mark-paragraph] 5575 ["Mark Block" markdown-mark-block] 5576 ["Mark Section" mark-defun] 5577 ["Mark Subtree" markdown-mark-subtree]) 5578 ("Tables" 5579 ["Move Row Up" markdown-move-up 5580 :enable (markdown-table-at-point-p) 5581 :keys "C-c <up>"] 5582 ["Move Row Down" markdown-move-down 5583 :enable (markdown-table-at-point-p) 5584 :keys "C-c <down>"] 5585 ["Move Column Left" markdown-promote 5586 :enable (markdown-table-at-point-p) 5587 :keys "C-c <left>"] 5588 ["Move Column Right" markdown-demote 5589 :enable (markdown-table-at-point-p) 5590 :keys "C-c <right>"] 5591 ["Delete Row" markdown-table-delete-row 5592 :enable (markdown-table-at-point-p)] 5593 ["Insert Row" markdown-table-insert-row 5594 :enable (markdown-table-at-point-p)] 5595 ["Delete Column" markdown-table-delete-column 5596 :enable (markdown-table-at-point-p)] 5597 ["Insert Column" markdown-table-insert-column 5598 :enable (markdown-table-at-point-p)] 5599 ["Insert Table" markdown-insert-table] 5600 "--" 5601 ["Convert Region to Table" markdown-table-convert-region] 5602 ["Sort Table Lines" markdown-table-sort-lines 5603 :enable (markdown-table-at-point-p)] 5604 ["Transpose Table" markdown-table-transpose 5605 :enable (markdown-table-at-point-p)]) 5606 ("Lists" 5607 ["Insert List Item" markdown-insert-list-item] 5608 ["Move Subtree Up" markdown-move-up 5609 :keys "C-c <up>"] 5610 ["Move Subtree Down" markdown-move-down 5611 :keys "C-c <down>"] 5612 ["Indent Subtree" markdown-demote 5613 :keys "C-c <right>"] 5614 ["Outdent Subtree" markdown-promote 5615 :keys "C-c <left>"] 5616 ["Renumber List" markdown-cleanup-list-numbers] 5617 ["Insert Task List Item" markdown-insert-gfm-checkbox 5618 :keys "C-c C-x ["] 5619 ["Toggle Task List Item" markdown-toggle-gfm-checkbox 5620 :enable (markdown-gfm-task-list-item-at-point) 5621 :keys "C-c C-d"]) 5622 ("Links & Images" 5623 ["Insert Link" markdown-insert-link] 5624 ["Insert Image" markdown-insert-image] 5625 ["Insert Footnote" markdown-insert-footnote 5626 :keys "C-c C-s f"] 5627 ["Insert Wiki Link" markdown-insert-wiki-link 5628 :keys "C-c C-s w"] 5629 "---" 5630 ["Check References" markdown-check-refs] 5631 ["Find Unused References" markdown-unused-refs] 5632 ["Toggle URL Hiding" markdown-toggle-url-hiding 5633 :style radio 5634 :selected markdown-hide-urls] 5635 ["Toggle Inline Images" markdown-toggle-inline-images 5636 :keys "C-c C-x C-i" 5637 :style radio 5638 :selected markdown-inline-image-overlays] 5639 ["Toggle Wiki Links" markdown-toggle-wiki-links 5640 :style radio 5641 :selected markdown-enable-wiki-links]) 5642 ("Styles" 5643 ["Bold" markdown-insert-bold] 5644 ["Italic" markdown-insert-italic] 5645 ["Code" markdown-insert-code] 5646 ["Strikethrough" markdown-insert-strike-through] 5647 ["Keyboard" markdown-insert-kbd] 5648 "---" 5649 ["Blockquote" markdown-insert-blockquote] 5650 ["Preformatted" markdown-insert-pre] 5651 ["GFM Code Block" markdown-insert-gfm-code-block] 5652 ["Edit Code Block" markdown-edit-code-block 5653 :enable (markdown-code-block-at-point-p)] 5654 ["Foldable Block" markdown-insert-foldable-block] 5655 "---" 5656 ["Blockquote Region" markdown-blockquote-region] 5657 ["Preformatted Region" markdown-pre-region] 5658 "---" 5659 ["Fontify Code Blocks Natively" 5660 markdown-toggle-fontify-code-blocks-natively 5661 :style radio 5662 :selected markdown-fontify-code-blocks-natively] 5663 ["LaTeX Math Support" markdown-toggle-math 5664 :style radio 5665 :selected markdown-enable-math]) 5666 "---" 5667 ("Preview & Export" 5668 ["Compile" markdown-other-window] 5669 ["Preview" markdown-preview] 5670 ["Export" markdown-export] 5671 ["Export & View" markdown-export-and-preview] 5672 ["Open" markdown-open] 5673 ["Live Export" markdown-live-preview-mode 5674 :style radio 5675 :selected markdown-live-preview-mode] 5676 ["Kill ring save" markdown-kill-ring-save]) 5677 ("Markup Completion and Cycling" 5678 ["Complete Markup" markdown-complete] 5679 ["Promote Element" markdown-promote 5680 :keys "C-c C--"] 5681 ["Demote Element" markdown-demote 5682 :keys "C-c C-="]) 5683 "---" 5684 ["Kill Element" markdown-kill-thing-at-point] 5685 "---" 5686 ("Documentation" 5687 ["Version" markdown-show-version] 5688 ["Homepage" markdown-mode-info] 5689 ["Describe Mode" (describe-function 'markdown-mode)] 5690 ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) 5691 5692 5693 ;;; imenu ===================================================================== 5694 5695 (defun markdown-imenu-create-nested-index () 5696 "Create and return a nested imenu index alist for the current buffer. 5697 See `imenu-create-index-function' and `imenu--index-alist' for details." 5698 (let* ((root '(nil . nil)) 5699 (min-level 9999) 5700 hashes headers) 5701 (save-excursion 5702 ;; Headings 5703 (goto-char (point-min)) 5704 (while (re-search-forward markdown-regex-header (point-max) t) 5705 (unless (or (markdown-code-block-at-point-p) 5706 (and (match-beginning 3) 5707 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) 5708 (cond 5709 ((match-string-no-properties 2) ;; level 1 setext 5710 (setq min-level 1) 5711 (push (list :heading (match-string-no-properties 1) 5712 :point (match-beginning 1) 5713 :level 1) headers)) 5714 ((match-string-no-properties 3) ;; level 2 setext 5715 (setq min-level (min min-level 2)) 5716 (push (list :heading (match-string-no-properties 1) 5717 :point (match-beginning 1) 5718 :level (- 2 (1- min-level))) headers)) 5719 ((setq hashes (markdown-trim-whitespace 5720 (match-string-no-properties 4))) 5721 (setq min-level (min min-level (length hashes))) 5722 (push (list :heading (match-string-no-properties 5) 5723 :point (match-beginning 4) 5724 :level (- (length hashes) (1- min-level))) headers))))) 5725 (cl-loop with cur-level = 0 5726 with cur-alist = nil 5727 with empty-heading = "-" 5728 with self-heading = "." 5729 for header in (reverse headers) 5730 for level = (plist-get header :level) 5731 do 5732 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) 5733 (cond 5734 ((= cur-level level) ; new sibling 5735 (setcdr cur-alist alist) 5736 (setq cur-alist alist)) 5737 ((< cur-level level) ; first child 5738 (dotimes (_ (- level cur-level 1)) 5739 (setq alist (list (cons empty-heading alist)))) 5740 (if cur-alist 5741 (let* ((parent (car cur-alist)) 5742 (self-pos (cdr parent))) 5743 (setcdr parent (cons (cons self-heading self-pos) alist))) 5744 (setcdr root alist)) ; primogenitor 5745 (setq cur-alist alist) 5746 (setq cur-level level)) 5747 (t ; new sibling of an ancestor 5748 (let ((sibling-alist (last (cdr root)))) 5749 (dotimes (_ (1- level)) 5750 (setq sibling-alist (last (cdar sibling-alist)))) 5751 (setcdr sibling-alist alist) 5752 (setq cur-alist alist)) 5753 (setq cur-level level))))) 5754 (setq root (copy-tree root)) 5755 ;; Footnotes 5756 (let ((fn (markdown-get-defined-footnotes))) 5757 (if (or (zerop (length fn)) 5758 (null markdown-add-footnotes-to-imenu)) 5759 (cdr root) 5760 (nconc (cdr root) (list (cons "Footnotes" fn)))))))) 5761 5762 (defun markdown-imenu-create-flat-index () 5763 "Create and return a flat imenu index alist for the current buffer. 5764 See `imenu-create-index-function' and `imenu--index-alist' for details." 5765 (let* ((empty-heading "-") index heading pos) 5766 (save-excursion 5767 ;; Headings 5768 (goto-char (point-min)) 5769 (while (re-search-forward markdown-regex-header (point-max) t) 5770 (when (and (not (markdown-code-block-at-point-p (point-at-bol))) 5771 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) 5772 (cond 5773 ((setq heading (match-string-no-properties 1)) 5774 (setq pos (match-beginning 1))) 5775 ((setq heading (match-string-no-properties 5)) 5776 (setq pos (match-beginning 4)))) 5777 (or (> (length heading) 0) 5778 (setq heading empty-heading)) 5779 (setq index (append index (list (cons heading pos)))))) 5780 ;; Footnotes 5781 (when markdown-add-footnotes-to-imenu 5782 (nconc index (markdown-get-defined-footnotes))) 5783 index))) 5784 5785 5786 ;;; References ================================================================ 5787 5788 (defun markdown-reference-goto-definition () 5789 "Jump to the definition of the reference at point or create it." 5790 (interactive) 5791 (when (thing-at-point-looking-at markdown-regex-link-reference) 5792 (let* ((text (match-string-no-properties 3)) 5793 (reference (match-string-no-properties 6)) 5794 (target (downcase (if (string= reference "") text reference))) 5795 (loc (cadr (save-match-data (markdown-reference-definition target))))) 5796 (if loc 5797 (goto-char loc) 5798 (goto-char (match-beginning 0)) 5799 (markdown-insert-reference-definition target))))) 5800 5801 (defun markdown-reference-find-links (reference) 5802 "Return a list of all links for REFERENCE. 5803 REFERENCE should not include the surrounding square brackets. 5804 Elements of the list have the form (text start line), where 5805 text is the link text, start is the location at the beginning of 5806 the link, and line is the line number on which the link appears." 5807 (let* ((ref-quote (regexp-quote reference)) 5808 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" 5809 ref-quote ref-quote)) 5810 links) 5811 (save-excursion 5812 (goto-char (point-min)) 5813 (while (re-search-forward regexp nil t) 5814 (let* ((text (or (match-string-no-properties 1) 5815 (match-string-no-properties 2))) 5816 (start (match-beginning 0)) 5817 (line (markdown-line-number-at-pos))) 5818 (cl-pushnew (list text start line) links :test #'equal)))) 5819 links)) 5820 5821 (defmacro markdown-for-all-refs (f) 5822 `(let ((result)) 5823 (save-excursion 5824 (goto-char (point-min)) 5825 (while 5826 (re-search-forward markdown-regex-link-reference nil t) 5827 (let* ((text (match-string-no-properties 3)) 5828 (reference (match-string-no-properties 6)) 5829 (target (downcase (if (string= reference "") text reference)))) 5830 (,f text target result)))) 5831 (reverse result))) 5832 5833 (defmacro markdown-collect-always (_ target result) 5834 `(cl-pushnew ,target ,result :test #'equal)) 5835 5836 (defmacro markdown-collect-undefined (text target result) 5837 `(unless (markdown-reference-definition target) 5838 (let ((entry (assoc ,target ,result))) 5839 (if (not entry) 5840 (cl-pushnew 5841 (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) 5842 ,result :test #'equal) 5843 (setcdr entry 5844 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) 5845 5846 (defun markdown-get-all-refs () 5847 "Return a list of all Markdown references." 5848 (markdown-for-all-refs markdown-collect-always)) 5849 5850 (defun markdown-get-undefined-refs () 5851 "Return a list of undefined Markdown references. 5852 Result is an alist of pairs (reference . occurrences), where 5853 occurrences is itself another alist of pairs (label . line-number). 5854 For example, an alist corresponding to [Nice editor][Emacs] at line 12, 5855 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is 5856 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." 5857 (markdown-for-all-refs markdown-collect-undefined)) 5858 5859 (defun markdown-get-unused-refs () 5860 (cl-sort 5861 (cl-set-difference 5862 (markdown-get-defined-references) (markdown-get-all-refs) 5863 :test (lambda (e1 e2) (equal (car e1) e2))) 5864 #'< :key #'cdr)) 5865 5866 (defmacro defun-markdown-buffer (name docstring) 5867 "Define a function to name and return a buffer. 5868 5869 By convention, NAME must be a name of a string constant with 5870 %buffer% placeholder used to name the buffer, and will also be 5871 used as a name of the function defined. 5872 5873 DOCSTRING will be used as the first part of the docstring." 5874 `(defun ,name (&optional buffer-name) 5875 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") 5876 (or buffer-name (setq buffer-name (buffer-name))) 5877 (let ((refbuf (get-buffer-create (replace-regexp-in-string 5878 "%buffer%" buffer-name 5879 ,name)))) 5880 (with-current-buffer refbuf 5881 (when view-mode 5882 (View-exit-and-edit)) 5883 (use-local-map button-buffer-map) 5884 (erase-buffer)) 5885 refbuf))) 5886 5887 (defconst markdown-reference-check-buffer 5888 "*Undefined references for %buffer%*" 5889 "Pattern for name of buffer for listing undefined references. 5890 The string %buffer% will be replaced by the corresponding 5891 `markdown-mode' buffer name.") 5892 5893 (defun-markdown-buffer 5894 markdown-reference-check-buffer 5895 "Name and return buffer for reference checking.") 5896 5897 (defconst markdown-unused-references-buffer 5898 "*Unused references for %buffer%*" 5899 "Pattern for name of buffer for listing unused references. 5900 The string %buffer% will be replaced by the corresponding 5901 `markdown-mode' buffer name.") 5902 5903 (defun-markdown-buffer 5904 markdown-unused-references-buffer 5905 "Name and return buffer for unused reference checking.") 5906 5907 (defconst markdown-reference-links-buffer 5908 "*Reference links for %buffer%*" 5909 "Pattern for name of buffer for listing references. 5910 The string %buffer% will be replaced by the corresponding buffer name.") 5911 5912 (defun-markdown-buffer 5913 markdown-reference-links-buffer 5914 "Name, setup, and return a buffer for listing links.") 5915 5916 ;; Add an empty Markdown reference definition to buffer 5917 ;; specified in the 'target-buffer property. The reference name is 5918 ;; the button's label. 5919 (define-button-type 'markdown-undefined-reference-button 5920 'help-echo "mouse-1, RET: create definition for undefined reference" 5921 'follow-link t 5922 'face 'bold 5923 'action (lambda (b) 5924 (let ((buffer (button-get b 'target-buffer)) 5925 (line (button-get b 'target-line)) 5926 (label (button-label b))) 5927 (switch-to-buffer-other-window buffer) 5928 (goto-char (point-min)) 5929 (forward-line line) 5930 (markdown-insert-reference-definition label) 5931 (markdown-check-refs t)))) 5932 5933 ;; Jump to line in buffer specified by 'target-buffer property. 5934 ;; Line number is button's 'target-line property. 5935 (define-button-type 'markdown-goto-line-button 5936 'help-echo "mouse-1, RET: go to line" 5937 'follow-link t 5938 'face 'italic 5939 'action (lambda (b) 5940 (switch-to-buffer-other-window (button-get b 'target-buffer)) 5941 ;; use call-interactively to silence compiler 5942 (let ((current-prefix-arg (button-get b 'target-line))) 5943 (call-interactively 'goto-line)))) 5944 5945 ;; Kill a line in buffer specified by 'target-buffer property. 5946 ;; Line number is button's 'target-line property. 5947 (define-button-type 'markdown-kill-line-button 5948 'help-echo "mouse-1, RET: kill line" 5949 'follow-link t 5950 'face 'italic 5951 'action (lambda (b) 5952 (switch-to-buffer-other-window (button-get b 'target-buffer)) 5953 ;; use call-interactively to silence compiler 5954 (let ((current-prefix-arg (button-get b 'target-line))) 5955 (call-interactively 'goto-line)) 5956 (kill-line 1) 5957 (markdown-unused-refs t))) 5958 5959 ;; Jumps to a particular link at location given by 'target-char 5960 ;; property in buffer given by 'target-buffer property. 5961 (define-button-type 'markdown-location-button 5962 'help-echo "mouse-1, RET: jump to location of link" 5963 'follow-link t 5964 'face 'bold 5965 'action (lambda (b) 5966 (let ((target (button-get b 'target-buffer)) 5967 (loc (button-get b 'target-char))) 5968 (kill-buffer-and-window) 5969 (switch-to-buffer target) 5970 (goto-char loc)))) 5971 5972 (defun markdown-insert-undefined-reference-button (reference oldbuf) 5973 "Insert a button for creating REFERENCE in buffer OLDBUF. 5974 REFERENCE should be a list of the form (reference . occurrences), 5975 as returned by `markdown-get-undefined-refs'." 5976 (let ((label (car reference))) 5977 ;; Create a reference button 5978 (insert-button label 5979 :type 'markdown-undefined-reference-button 5980 'target-buffer oldbuf 5981 'target-line (cdr (car (cdr reference)))) 5982 (insert " (") 5983 (dolist (occurrence (cdr reference)) 5984 (let ((line (cdr occurrence))) 5985 ;; Create a line number button 5986 (insert-button (number-to-string line) 5987 :type 'markdown-goto-line-button 5988 'target-buffer oldbuf 5989 'target-line line) 5990 (insert " "))) 5991 (delete-char -1) 5992 (insert ")") 5993 (newline))) 5994 5995 (defun markdown-insert-unused-reference-button (reference oldbuf) 5996 "Insert a button for creating REFERENCE in buffer OLDBUF. 5997 REFERENCE must be a pair of (ref . line-number)." 5998 (let ((label (car reference)) 5999 (line (cdr reference))) 6000 ;; Create a reference button 6001 (insert-button label 6002 :type 'markdown-goto-line-button 6003 'face 'bold 6004 'target-buffer oldbuf 6005 'target-line line) 6006 (insert (format " (%d) [" line)) 6007 (insert-button "X" 6008 :type 'markdown-kill-line-button 6009 'face 'bold 6010 'target-buffer oldbuf 6011 'target-line line) 6012 (insert "]") 6013 (newline))) 6014 6015 (defun markdown-insert-link-button (link oldbuf) 6016 "Insert a button for jumping to LINK in buffer OLDBUF. 6017 LINK should be a list of the form (text char line) containing 6018 the link text, location, and line number." 6019 (let ((label (cl-first link)) 6020 (char (cl-second link)) 6021 (line (cl-third link))) 6022 ;; Create a reference button 6023 (insert-button label 6024 :type 'markdown-location-button 6025 'target-buffer oldbuf 6026 'target-char char) 6027 (insert (format " (line %d)\n" line)))) 6028 6029 (defun markdown-reference-goto-link (&optional reference) 6030 "Jump to the location of the first use of REFERENCE." 6031 (interactive) 6032 (unless reference 6033 (if (thing-at-point-looking-at markdown-regex-reference-definition) 6034 (setq reference (match-string-no-properties 2)) 6035 (user-error "No reference definition at point"))) 6036 (let ((links (markdown-reference-find-links reference))) 6037 (cond ((= (length links) 1) 6038 (goto-char (cadr (car links)))) 6039 ((> (length links) 1) 6040 (let ((oldbuf (current-buffer)) 6041 (linkbuf (markdown-reference-links-buffer))) 6042 (with-current-buffer linkbuf 6043 (insert "Links using reference " reference ":\n\n") 6044 (dolist (link (reverse links)) 6045 (markdown-insert-link-button link oldbuf))) 6046 (view-buffer-other-window linkbuf) 6047 (goto-char (point-min)) 6048 (forward-line 2))) 6049 (t 6050 (error "No links for reference %s" reference))))) 6051 6052 (defmacro defun-markdown-ref-checker 6053 (name docstring checker-function buffer-function none-message buffer-header insert-reference) 6054 "Define a function NAME acting on result of CHECKER-FUNCTION. 6055 6056 DOCSTRING is used as a docstring for the defined function. 6057 6058 BUFFER-FUNCTION should name and return an auxiliary buffer to put 6059 results in. 6060 6061 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. 6062 6063 BUFFER-HEADER is put into the auxiliary buffer first, followed by 6064 calling INSERT-REFERENCE for each element in the list returned by 6065 CHECKER-FUNCTION." 6066 `(defun ,name (&optional silent) 6067 ,(concat 6068 docstring 6069 "\n\nIf SILENT is non-nil, do not message anything when no 6070 such references found.") 6071 (interactive "P") 6072 (unless (derived-mode-p 'markdown-mode) 6073 (user-error "Not available in current mode")) 6074 (let ((oldbuf (current-buffer)) 6075 (refs (,checker-function)) 6076 (refbuf (,buffer-function))) 6077 (if (null refs) 6078 (progn 6079 (when (not silent) 6080 (message ,none-message)) 6081 (kill-buffer refbuf)) 6082 (with-current-buffer refbuf 6083 (insert ,buffer-header) 6084 (dolist (ref refs) 6085 (,insert-reference ref oldbuf)) 6086 (view-buffer-other-window refbuf) 6087 (goto-char (point-min)) 6088 (forward-line 2)))))) 6089 6090 (defun-markdown-ref-checker 6091 markdown-check-refs 6092 "Show all undefined Markdown references in current `markdown-mode' buffer. 6093 6094 Links which have empty reference definitions are considered to be 6095 defined." 6096 markdown-get-undefined-refs 6097 markdown-reference-check-buffer 6098 "No undefined references found" 6099 "The following references are undefined:\n\n" 6100 markdown-insert-undefined-reference-button) 6101 6102 6103 (defun-markdown-ref-checker 6104 markdown-unused-refs 6105 "Show all unused Markdown references in current `markdown-mode' buffer." 6106 markdown-get-unused-refs 6107 markdown-unused-references-buffer 6108 "No unused references found" 6109 "The following references are unused:\n\n" 6110 markdown-insert-unused-reference-button) 6111 6112 6113 6114 ;;; Lists ===================================================================== 6115 6116 (defun markdown-insert-list-item (&optional arg) 6117 "Insert a new list item. 6118 If the point is inside unordered list, insert a bullet mark. If 6119 the point is inside ordered list, insert the next number followed 6120 by a period. Use the previous list item to determine the amount 6121 of whitespace to place before and after list markers. 6122 6123 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 6124 decrease the indentation by one level. 6125 6126 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 6127 increase the indentation by one level." 6128 (interactive "p") 6129 (let (bounds cur-indent marker indent new-indent new-loc) 6130 (save-match-data 6131 ;; Look for a list item on current or previous non-blank line 6132 (save-excursion 6133 (while (and (not (setq bounds (markdown-cur-list-item-bounds))) 6134 (not (bobp)) 6135 (markdown-cur-line-blank-p)) 6136 (forward-line -1))) 6137 (when bounds 6138 (cond ((save-excursion 6139 (skip-chars-backward " \t") 6140 (looking-at-p markdown-regex-list)) 6141 (beginning-of-line) 6142 (insert "\n") 6143 (forward-line -1)) 6144 ((not (markdown-cur-line-blank-p)) 6145 (newline))) 6146 (setq new-loc (point))) 6147 ;; Look ahead for a list item on next non-blank line 6148 (unless bounds 6149 (save-excursion 6150 (while (and (null bounds) 6151 (not (eobp)) 6152 (markdown-cur-line-blank-p)) 6153 (forward-line) 6154 (setq bounds (markdown-cur-list-item-bounds)))) 6155 (when bounds 6156 (setq new-loc (point)) 6157 (unless (markdown-cur-line-blank-p) 6158 (newline)))) 6159 (if (not bounds) 6160 ;; When not in a list, start a new unordered one 6161 (progn 6162 (unless (markdown-cur-line-blank-p) 6163 (insert "\n")) 6164 (insert markdown-unordered-list-item-prefix)) 6165 ;; Compute indentation and marker for new list item 6166 (setq cur-indent (nth 2 bounds)) 6167 (setq marker (nth 4 bounds)) 6168 ;; If current item is a GFM checkbox, insert new unchecked checkbox. 6169 (when (nth 5 bounds) 6170 (setq marker 6171 (concat marker 6172 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) 6173 (cond 6174 ;; Dedent: decrement indentation, find previous marker. 6175 ((= arg 4) 6176 (setq indent (max (- cur-indent markdown-list-indent-width) 0)) 6177 (let ((prev-bounds 6178 (save-excursion 6179 (goto-char (nth 0 bounds)) 6180 (when (markdown-up-list) 6181 (markdown-cur-list-item-bounds))))) 6182 (when prev-bounds 6183 (setq marker (nth 4 prev-bounds))))) 6184 ;; Indent: increment indentation by 4, use same marker. 6185 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) 6186 ;; Same level: keep current indentation and marker. 6187 (t (setq indent cur-indent))) 6188 (setq new-indent (make-string indent 32)) 6189 (goto-char new-loc) 6190 (cond 6191 ;; Ordered list 6192 ((string-match-p "[0-9]" marker) 6193 (if (= arg 16) ;; starting a new column indented one more level 6194 (insert (concat new-indent "1. ")) 6195 ;; Don't use previous match-data 6196 (set-match-data nil) 6197 ;; travel up to the last item and pick the correct number. If 6198 ;; the argument was nil, "new-indent = cur-indent" is the same, 6199 ;; so we don't need special treatment. Neat. 6200 (save-excursion 6201 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) 6202 (>= (forward-line -1) 0)))) 6203 (let* ((old-prefix (match-string 1)) 6204 (old-spacing (match-string 2)) 6205 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) 6206 (int-to-string (1+ (string-to-number old-prefix))) 6207 "1")) 6208 (space-adjust (- (length old-prefix) (length new-prefix))) 6209 (new-spacing (if (and (match-string 2) 6210 (not (string-match-p "\t" old-spacing)) 6211 (< space-adjust 0) 6212 (> space-adjust (- 1 (length (match-string 2))))) 6213 (substring (match-string 2) 0 space-adjust) 6214 (or old-spacing ". ")))) 6215 (insert (concat new-indent new-prefix new-spacing))))) 6216 ;; Unordered list, GFM task list, or ordered list with hash mark 6217 ((string-match-p "[\\*\\+-]\\|#\\." marker) 6218 (insert new-indent marker)))) 6219 ;; Propertize the newly inserted list item now 6220 (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol))))) 6221 6222 (defun markdown-move-list-item-up () 6223 "Move the current list item up in the list when possible. 6224 In nested lists, move child items with the parent item." 6225 (interactive) 6226 (let (cur prev old) 6227 (when (setq cur (markdown-cur-list-item-bounds)) 6228 (setq old (point)) 6229 (goto-char (nth 0 cur)) 6230 (if (markdown-prev-list-item (nth 3 cur)) 6231 (progn 6232 (setq prev (markdown-cur-list-item-bounds)) 6233 (condition-case nil 6234 (progn 6235 (transpose-regions (nth 0 prev) (nth 1 prev) 6236 (nth 0 cur) (nth 1 cur) t) 6237 (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) 6238 ;; Catch error in case regions overlap. 6239 (error (goto-char old)))) 6240 (goto-char old))))) 6241 6242 (defun markdown-move-list-item-down () 6243 "Move the current list item down in the list when possible. 6244 In nested lists, move child items with the parent item." 6245 (interactive) 6246 (let (cur next old) 6247 (when (setq cur (markdown-cur-list-item-bounds)) 6248 (setq old (point)) 6249 (if (markdown-next-list-item (nth 3 cur)) 6250 (progn 6251 (setq next (markdown-cur-list-item-bounds)) 6252 (condition-case nil 6253 (progn 6254 (transpose-regions (nth 0 cur) (nth 1 cur) 6255 (nth 0 next) (nth 1 next) nil) 6256 (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) 6257 ;; Catch error in case regions overlap. 6258 (error (goto-char old)))) 6259 (goto-char old))))) 6260 6261 (defun markdown-demote-list-item (&optional bounds) 6262 "Indent (or demote) the current list item. 6263 Optionally, BOUNDS of the current list item may be provided if available. 6264 In nested lists, demote child items as well." 6265 (interactive) 6266 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6267 (save-excursion 6268 (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) 6269 (item-end (set-marker (make-marker) (nth 1 bounds))) 6270 (list-start (progn (markdown-beginning-of-list) 6271 (set-marker (make-marker) (point)))) 6272 (list-end (progn (markdown-end-of-list) 6273 (set-marker (make-marker) (point))))) 6274 (goto-char item-start) 6275 (while (< (point) item-end) 6276 (unless (markdown-cur-line-blank-p) 6277 (insert (make-string markdown-list-indent-width ? ))) 6278 (forward-line)) 6279 (markdown-syntax-propertize-list-items list-start list-end))))) 6280 6281 (defun markdown-promote-list-item (&optional bounds) 6282 "Unindent (or promote) the current list item. 6283 Optionally, BOUNDS of the current list item may be provided if available. 6284 In nested lists, demote child items as well." 6285 (interactive) 6286 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6287 (save-excursion 6288 (save-match-data 6289 (let ((item-start (set-marker (make-marker) (nth 0 bounds))) 6290 (item-end (set-marker (make-marker) (nth 1 bounds))) 6291 (list-start (progn (markdown-beginning-of-list) 6292 (set-marker (make-marker) (point)))) 6293 (list-end (progn (markdown-end-of-list) 6294 (set-marker (make-marker) (point)))) 6295 num regexp) 6296 (goto-char item-start) 6297 (when (looking-at (format "^[ ]\\{1,%d\\}" 6298 markdown-list-indent-width)) 6299 (setq num (- (match-end 0) (match-beginning 0))) 6300 (setq regexp (format "^[ ]\\{1,%d\\}" num)) 6301 (while (and (< (point) item-end) 6302 (re-search-forward regexp item-end t)) 6303 (replace-match "" nil nil) 6304 (forward-line)) 6305 (markdown-syntax-propertize-list-items list-start list-end))))))) 6306 6307 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) 6308 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. 6309 PREV-ITEM is width of previous-indentation and list number 6310 6311 Assume that the previously found match was for a numbered item in 6312 a list." 6313 (let ((cpfx pfx) 6314 (cur-item nil) 6315 (idx 0) 6316 (continue t) 6317 (step t) 6318 (sep nil)) 6319 (while (and continue (not (eobp))) 6320 (setq step t) 6321 (cond 6322 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") 6323 (setq cpfx (match-string-no-properties 2)) 6324 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker 6325 (cond 6326 ((or (= (length cpfx) (length pfx)) 6327 (= (length cur-item) (length prev-item))) 6328 (save-excursion 6329 (replace-match 6330 (if (not markdown-ordered-list-enumeration) 6331 (concat pfx "1. ") 6332 (cl-incf idx) 6333 (concat pfx (number-to-string idx) ". ")))) 6334 (setq sep nil)) 6335 ;; indented a level 6336 ((< (length pfx) (length cpfx)) 6337 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) 6338 (setq step nil)) 6339 ;; exit the loop 6340 (t 6341 (setq step nil) 6342 (setq continue nil)))) 6343 6344 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") 6345 (setq cpfx (match-string-no-properties 1)) 6346 (cond 6347 ;; reset if separated before 6348 ((string= cpfx pfx) (when sep (setq idx 0))) 6349 ((string< cpfx pfx) 6350 (setq step nil) 6351 (setq continue nil)))) 6352 (t (setq sep t))) 6353 6354 (when step 6355 (beginning-of-line) 6356 (setq continue (= (forward-line) 0)))) 6357 sep)) 6358 6359 (defun markdown-cleanup-list-numbers () 6360 "Update the numbering of ordered lists." 6361 (interactive) 6362 (save-excursion 6363 (goto-char (point-min)) 6364 (markdown-cleanup-list-numbers-level ""))) 6365 6366 6367 ;;; Movement ================================================================== 6368 6369 (defun markdown-beginning-of-defun (&optional arg) 6370 "`beginning-of-defun-function' for Markdown. 6371 This is used to find the beginning of the defun and should behave 6372 like ‘beginning-of-defun’, returning non-nil if it found the 6373 beginning of a defun. It moves the point backward, right before a 6374 heading which defines a defun. When ARG is non-nil, repeat that 6375 many times. When ARG is negative, move forward to the ARG-th 6376 following section." 6377 (or arg (setq arg 1)) 6378 (when (< arg 0) (end-of-line)) 6379 ;; Adjust position for setext headings. 6380 (when (and (thing-at-point-looking-at markdown-regex-header-setext) 6381 (not (= (point) (match-beginning 0))) 6382 (not (markdown-code-block-at-point-p))) 6383 (goto-char (match-end 0))) 6384 (let (found) 6385 ;; Move backward with positive argument. 6386 (while (and (not (bobp)) (> arg 0)) 6387 (setq found nil) 6388 (while (and (not found) 6389 (not (bobp)) 6390 (re-search-backward markdown-regex-header nil 'move)) 6391 (when (not (markdown-code-block-at-pos (match-beginning 0)))) 6392 (setq found (match-beginning 0))) 6393 (setq arg (1- arg))) 6394 ;; Move forward with negative argument. 6395 (while (and (not (eobp)) (< arg 0)) 6396 (setq found nil) 6397 (while (and (not found) 6398 (not (eobp)) 6399 (re-search-forward markdown-regex-header nil 'move)) 6400 (when (not (markdown-code-block-at-pos (match-beginning 0)))) 6401 (setq found (match-beginning 0))) 6402 (setq arg (1+ arg))) 6403 (when found 6404 (beginning-of-line) 6405 t))) 6406 6407 (defun markdown-end-of-defun () 6408 "`end-of-defun-function’ for Markdown. 6409 This is used to find the end of the defun at point. 6410 It is called with no argument, right after calling ‘beginning-of-defun-raw’, 6411 so it can assume that point is at the beginning of the defun body. 6412 It should move point to the first position after the defun." 6413 (or (eobp) (forward-char 1)) 6414 (let (found) 6415 (while (and (not found) 6416 (not (eobp)) 6417 (re-search-forward markdown-regex-header nil 'move)) 6418 (when (not (markdown-code-block-at-pos (match-beginning 0))) 6419 (setq found (match-beginning 0)))) 6420 (when found 6421 (goto-char found) 6422 (skip-syntax-backward "-")))) 6423 6424 (defun markdown-beginning-of-text-block () 6425 "Move backward to previous beginning of a plain text block. 6426 This function simply looks for blank lines without considering 6427 the surrounding context in light of Markdown syntax. For that, see 6428 `markdown-backward-block'." 6429 (interactive) 6430 (let ((start (point))) 6431 (if (re-search-backward markdown-regex-block-separator nil t) 6432 (goto-char (match-end 0)) 6433 (goto-char (point-min))) 6434 (when (and (= start (point)) (not (bobp))) 6435 (forward-line -1) 6436 (if (re-search-backward markdown-regex-block-separator nil t) 6437 (goto-char (match-end 0)) 6438 (goto-char (point-min)))))) 6439 6440 (defun markdown-end-of-text-block () 6441 "Move forward to next beginning of a plain text block. 6442 This function simply looks for blank lines without considering 6443 the surrounding context in light of Markdown syntax. For that, see 6444 `markdown-forward-block'." 6445 (interactive) 6446 (beginning-of-line) 6447 (skip-chars-forward " \t\n") 6448 (when (= (point) (point-min)) 6449 (forward-char)) 6450 (if (re-search-forward markdown-regex-block-separator nil t) 6451 (goto-char (match-end 0)) 6452 (goto-char (point-max))) 6453 (skip-chars-backward " \t\n") 6454 (forward-line)) 6455 6456 (defun markdown-backward-paragraph (&optional arg) 6457 "Move the point to the start of the current paragraph. 6458 With argument ARG, do it ARG times; a negative argument ARG = -N 6459 means move forward N blocks." 6460 (interactive "^p") 6461 (or arg (setq arg 1)) 6462 (if (< arg 0) 6463 (markdown-forward-paragraph (- arg)) 6464 (dotimes (_ arg) 6465 ;; Skip over whitespace in between paragraphs when moving backward. 6466 (skip-chars-backward " \t\n") 6467 (beginning-of-line) 6468 ;; Skip over code block endings. 6469 (when (markdown-range-properties-exist 6470 (point-at-bol) (point-at-eol) 6471 '(markdown-gfm-block-end 6472 markdown-tilde-fence-end)) 6473 (forward-line -1)) 6474 ;; Skip over blank lines inside blockquotes. 6475 (while (and (not (eobp)) 6476 (looking-at markdown-regex-blockquote) 6477 (= (length (match-string 3)) 0)) 6478 (forward-line -1)) 6479 ;; Proceed forward based on the type of block of paragraph. 6480 (let (bounds skip) 6481 (cond 6482 ;; Blockquotes 6483 ((looking-at markdown-regex-blockquote) 6484 (while (and (not (bobp)) 6485 (looking-at markdown-regex-blockquote) 6486 (> (length (match-string 3)) 0)) ;; not blank 6487 (forward-line -1)) 6488 (forward-line)) 6489 ;; List items 6490 ((setq bounds (markdown-cur-list-item-bounds)) 6491 (goto-char (nth 0 bounds))) 6492 ;; Other 6493 (t 6494 (while (and (not (bobp)) 6495 (not skip) 6496 (not (markdown-cur-line-blank-p)) 6497 (not (looking-at markdown-regex-blockquote)) 6498 (not (markdown-range-properties-exist 6499 (point-at-bol) (point-at-eol) 6500 '(markdown-gfm-block-end 6501 markdown-tilde-fence-end)))) 6502 (setq skip (markdown-range-properties-exist 6503 (point-at-bol) (point-at-eol) 6504 '(markdown-gfm-block-begin 6505 markdown-tilde-fence-begin))) 6506 (forward-line -1)) 6507 (unless (bobp) 6508 (forward-line 1)))))))) 6509 6510 (defun markdown-forward-paragraph (&optional arg) 6511 "Move forward to the next end of a paragraph. 6512 With argument ARG, do it ARG times; a negative argument ARG = -N 6513 means move backward N blocks." 6514 (interactive "^p") 6515 (or arg (setq arg 1)) 6516 (if (< arg 0) 6517 (markdown-backward-paragraph (- arg)) 6518 (dotimes (_ arg) 6519 ;; Skip whitespace in between paragraphs. 6520 (when (markdown-cur-line-blank-p) 6521 (skip-syntax-forward "-") 6522 (beginning-of-line)) 6523 ;; Proceed forward based on the type of block. 6524 (let (bounds skip) 6525 (cond 6526 ;; Blockquotes 6527 ((looking-at markdown-regex-blockquote) 6528 ;; Skip over blank lines inside blockquotes. 6529 (while (and (not (eobp)) 6530 (looking-at markdown-regex-blockquote) 6531 (= (length (match-string 3)) 0)) 6532 (forward-line)) 6533 ;; Move to end of quoted text block 6534 (while (and (not (eobp)) 6535 (looking-at markdown-regex-blockquote) 6536 (> (length (match-string 3)) 0)) ;; not blank 6537 (forward-line))) 6538 ;; List items 6539 ((and (markdown-cur-list-item-bounds) 6540 (setq bounds (markdown-next-list-item-bounds))) 6541 (goto-char (nth 0 bounds))) 6542 ;; Other 6543 (t 6544 (forward-line) 6545 (while (and (not (eobp)) 6546 (not skip) 6547 (not (markdown-cur-line-blank-p)) 6548 (not (looking-at markdown-regex-blockquote)) 6549 (not (markdown-range-properties-exist 6550 (point-at-bol) (point-at-eol) 6551 '(markdown-gfm-block-begin 6552 markdown-tilde-fence-begin)))) 6553 (setq skip (markdown-range-properties-exist 6554 (point-at-bol) (point-at-eol) 6555 '(markdown-gfm-block-end 6556 markdown-tilde-fence-end))) 6557 (forward-line)))))))) 6558 6559 (defun markdown-backward-block (&optional arg) 6560 "Move the point to the start of the current Markdown block. 6561 Moves across complete code blocks, list items, and blockquotes, 6562 but otherwise stops at blank lines, headers, and horizontal 6563 rules. With argument ARG, do it ARG times; a negative argument 6564 ARG = -N means move forward N blocks." 6565 (interactive "^p") 6566 (or arg (setq arg 1)) 6567 (if (< arg 0) 6568 (markdown-forward-block (- arg)) 6569 (dotimes (_ arg) 6570 ;; Skip over whitespace in between blocks when moving backward, 6571 ;; unless at a block boundary with no whitespace. 6572 (skip-syntax-backward "-") 6573 (beginning-of-line) 6574 ;; Proceed forward based on the type of block. 6575 (cond 6576 ;; Code blocks 6577 ((and (markdown-code-block-at-pos (point)) ;; this line 6578 (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line 6579 (forward-line -1) 6580 (while (and (markdown-code-block-at-point-p) (not (bobp))) 6581 (forward-line -1)) 6582 (forward-line)) 6583 ;; Headings 6584 ((markdown-heading-at-point) 6585 (goto-char (match-beginning 0))) 6586 ;; Horizontal rules 6587 ((looking-at markdown-regex-hr)) 6588 ;; Blockquotes 6589 ((looking-at markdown-regex-blockquote) 6590 (forward-line -1) 6591 (while (and (looking-at markdown-regex-blockquote) 6592 (not (bobp))) 6593 (forward-line -1)) 6594 (forward-line)) 6595 ;; List items 6596 ((markdown-cur-list-item-bounds) 6597 (markdown-beginning-of-list)) 6598 ;; Other 6599 (t 6600 ;; Move forward in case it is a one line regular paragraph. 6601 (unless (markdown-next-line-blank-p) 6602 (forward-line)) 6603 (unless (markdown-prev-line-blank-p) 6604 (markdown-backward-paragraph))))))) 6605 6606 (defun markdown-forward-block (&optional arg) 6607 "Move forward to the next end of a Markdown block. 6608 Moves across complete code blocks, list items, and blockquotes, 6609 but otherwise stops at blank lines, headers, and horizontal 6610 rules. With argument ARG, do it ARG times; a negative argument 6611 ARG = -N means move backward N blocks." 6612 (interactive "^p") 6613 (or arg (setq arg 1)) 6614 (if (< arg 0) 6615 (markdown-backward-block (- arg)) 6616 (dotimes (_ arg) 6617 ;; Skip over whitespace in between blocks when moving forward. 6618 (if (markdown-cur-line-blank-p) 6619 (skip-syntax-forward "-") 6620 (beginning-of-line)) 6621 ;; Proceed forward based on the type of block. 6622 (cond 6623 ;; Code blocks 6624 ((markdown-code-block-at-point-p) 6625 (forward-line) 6626 (while (and (markdown-code-block-at-point-p) (not (eobp))) 6627 (forward-line))) 6628 ;; Headings 6629 ((looking-at markdown-regex-header) 6630 (goto-char (or (match-end 4) (match-end 2) (match-end 3))) 6631 (forward-line)) 6632 ;; Horizontal rules 6633 ((looking-at markdown-regex-hr) 6634 (forward-line)) 6635 ;; Blockquotes 6636 ((looking-at markdown-regex-blockquote) 6637 (forward-line) 6638 (while (and (looking-at markdown-regex-blockquote) (not (eobp))) 6639 (forward-line))) 6640 ;; List items 6641 ((markdown-cur-list-item-bounds) 6642 (markdown-end-of-list) 6643 (forward-line)) 6644 ;; Other 6645 (t (markdown-forward-paragraph)))) 6646 (skip-syntax-backward "-") 6647 (unless (eobp) 6648 (forward-char 1)))) 6649 6650 (defun markdown-backward-page (&optional count) 6651 "Move backward to boundary of the current toplevel section. 6652 With COUNT, repeat, or go forward if negative." 6653 (interactive "p") 6654 (or count (setq count 1)) 6655 (if (< count 0) 6656 (markdown-forward-page (- count)) 6657 (skip-syntax-backward "-") 6658 (or (markdown-back-to-heading-over-code-block t t) 6659 (goto-char (point-min))) 6660 (when (looking-at markdown-regex-header) 6661 (let ((level (markdown-outline-level))) 6662 (when (> level 1) (markdown-up-heading level)) 6663 (when (> count 1) 6664 (condition-case nil 6665 (markdown-backward-same-level (1- count)) 6666 (error (goto-char (point-min))))))))) 6667 6668 (defun markdown-forward-page (&optional count) 6669 "Move forward to boundary of the current toplevel section. 6670 With COUNT, repeat, or go backward if negative." 6671 (interactive "p") 6672 (or count (setq count 1)) 6673 (if (< count 0) 6674 (markdown-backward-page (- count)) 6675 (if (markdown-back-to-heading-over-code-block t t) 6676 (let ((level (markdown-outline-level))) 6677 (when (> level 1) (markdown-up-heading level)) 6678 (condition-case nil 6679 (markdown-forward-same-level count) 6680 (error (goto-char (point-max))))) 6681 (markdown-next-visible-heading 1)))) 6682 6683 (defun markdown-next-link () 6684 "Jump to next inline, reference, or wiki link. 6685 If successful, return point. Otherwise, return nil. 6686 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." 6687 (interactive) 6688 (let ((opoint (point))) 6689 (when (or (markdown-link-p) (markdown-wiki-link-p)) 6690 ;; At a link already, move past it. 6691 (goto-char (+ (match-end 0) 1))) 6692 ;; Search for the next wiki link and move to the beginning. 6693 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) 6694 (markdown-code-block-at-point-p) 6695 (< (point) (point-max)))) 6696 (if (and (not (eq (point) opoint)) 6697 (or (markdown-link-p) (markdown-wiki-link-p))) 6698 ;; Group 1 will move past non-escape character in wiki link regexp. 6699 ;; Go to beginning of group zero for all other link types. 6700 (goto-char (or (match-beginning 1) (match-beginning 0))) 6701 (goto-char opoint) 6702 nil))) 6703 6704 (defun markdown-previous-link () 6705 "Jump to previous wiki link. 6706 If successful, return point. Otherwise, return nil. 6707 See `markdown-wiki-link-p' and `markdown-next-wiki-link'." 6708 (interactive) 6709 (let ((opoint (point))) 6710 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) 6711 (markdown-code-block-at-point-p) 6712 (> (point) (point-min)))) 6713 (if (and (not (eq (point) opoint)) 6714 (or (markdown-link-p) (markdown-wiki-link-p))) 6715 (goto-char (or (match-beginning 1) (match-beginning 0))) 6716 (goto-char opoint) 6717 nil))) 6718 6719 6720 ;;; Outline =================================================================== 6721 6722 (defun markdown-move-heading-common (move-fn &optional arg adjust) 6723 "Wrapper for `outline-mode' functions to skip false positives. 6724 MOVE-FN is a function and ARG is its argument. For example, 6725 headings inside preformatted code blocks may match 6726 `outline-regexp' but should not be considered as headings. 6727 When ADJUST is non-nil, adjust the point for interactive calls 6728 to avoid leaving the point at invisible markup. This adjustment 6729 generally should only be done for interactive calls, since other 6730 functions may expect the point to be at the beginning of the 6731 regular expression." 6732 (let ((prev -1) (start (point))) 6733 (if arg (funcall move-fn arg) (funcall move-fn)) 6734 (while (and (/= prev (point)) (markdown-code-block-at-point-p)) 6735 (setq prev (point)) 6736 (if arg (funcall move-fn arg) (funcall move-fn))) 6737 ;; Adjust point for setext headings and invisible text. 6738 (save-match-data 6739 (when (and adjust (thing-at-point-looking-at markdown-regex-header)) 6740 (if markdown-hide-markup 6741 ;; Move to beginning of heading text if markup is hidden. 6742 (goto-char (or (match-beginning 1) (match-beginning 5))) 6743 ;; Move to beginning of markup otherwise. 6744 (goto-char (or (match-beginning 1) (match-beginning 4)))))) 6745 (if (= (point) start) nil (point)))) 6746 6747 (defun markdown-next-visible-heading (arg) 6748 "Move to the next visible heading line of any level. 6749 With argument, repeats or can move backward if negative. ARG is 6750 passed to `outline-next-visible-heading'." 6751 (interactive "p") 6752 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) 6753 6754 (defun markdown-previous-visible-heading (arg) 6755 "Move to the previous visible heading line of any level. 6756 With argument, repeats or can move backward if negative. ARG is 6757 passed to `outline-previous-visible-heading'." 6758 (interactive "p") 6759 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) 6760 6761 (defun markdown-next-heading () 6762 "Move to the next heading line of any level." 6763 (markdown-move-heading-common #'outline-next-heading)) 6764 6765 (defun markdown-previous-heading () 6766 "Move to the previous heading line of any level." 6767 (markdown-move-heading-common #'outline-previous-heading)) 6768 6769 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) 6770 "Move back to the beginning of the previous heading. 6771 Returns t if the point is at a heading, the location if a heading 6772 was found, and nil otherwise. 6773 Only visible heading lines are considered, unless INVISIBLE-OK is 6774 non-nil. Throw an error if there is no previous heading unless 6775 NO-ERROR is non-nil. 6776 Leaves match data intact for `markdown-regex-header'." 6777 (beginning-of-line) 6778 (or (and (markdown-heading-at-point) 6779 (not (markdown-code-block-at-point-p))) 6780 (let (found) 6781 (save-excursion 6782 (while (and (not found) 6783 (re-search-backward markdown-regex-header nil t)) 6784 (when (and (or invisible-ok (not (outline-invisible-p))) 6785 (not (markdown-code-block-at-point-p))) 6786 (setq found (point)))) 6787 (if (not found) 6788 (unless no-error (user-error "Before first heading")) 6789 (setq found (point)))) 6790 (when found (goto-char found))))) 6791 6792 (defun markdown-forward-same-level (arg) 6793 "Move forward to the ARG'th heading at same level as this one. 6794 Stop at the first and last headings of a superior heading." 6795 (interactive "p") 6796 (markdown-back-to-heading-over-code-block) 6797 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) 6798 6799 (defun markdown-backward-same-level (arg) 6800 "Move backward to the ARG'th heading at same level as this one. 6801 Stop at the first and last headings of a superior heading." 6802 (interactive "p") 6803 (markdown-back-to-heading-over-code-block) 6804 (while (> arg 0) 6805 (let ((point-to-move-to 6806 (save-excursion 6807 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) 6808 (if point-to-move-to 6809 (progn 6810 (goto-char point-to-move-to) 6811 (setq arg (1- arg))) 6812 (user-error "No previous same-level heading"))))) 6813 6814 (defun markdown-up-heading (arg &optional interactive) 6815 "Move to the visible heading line of which the present line is a subheading. 6816 With argument, move up ARG levels. When called interactively (or 6817 INTERACTIVE is non-nil), also push the mark." 6818 (interactive "p\np") 6819 (and interactive (not (eq last-command 'markdown-up-heading)) 6820 (push-mark)) 6821 (markdown-move-heading-common #'outline-up-heading arg 'adjust)) 6822 6823 (defun markdown-back-to-heading (&optional invisible-ok) 6824 "Move to previous heading line, or beg of this line if it's a heading. 6825 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 6826 (interactive) 6827 (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) 6828 6829 (defalias 'markdown-end-of-heading 'outline-end-of-heading) 6830 6831 (defun markdown-on-heading-p () 6832 "Return non-nil if point is on a heading line." 6833 (get-text-property (point-at-bol) 'markdown-heading)) 6834 6835 (defun markdown-end-of-subtree (&optional invisible-OK) 6836 "Move to the end of the current subtree. 6837 Only visible heading lines are considered, unless INVISIBLE-OK is 6838 non-nil. 6839 Derived from `org-end-of-subtree'." 6840 (markdown-back-to-heading invisible-OK) 6841 (let ((first t) 6842 (level (markdown-outline-level))) 6843 (while (and (not (eobp)) 6844 (or first (> (markdown-outline-level) level))) 6845 (setq first nil) 6846 (markdown-next-heading)) 6847 (if (memq (preceding-char) '(?\n ?\^M)) 6848 (progn 6849 ;; Go to end of line before heading 6850 (forward-char -1) 6851 (if (memq (preceding-char) '(?\n ?\^M)) 6852 ;; leave blank line before heading 6853 (forward-char -1))))) 6854 (point)) 6855 6856 (defun markdown-outline-fix-visibility () 6857 "Hide any false positive headings that should not be shown. 6858 For example, headings inside preformatted code blocks may match 6859 `outline-regexp' but should not be shown as headings when cycling. 6860 Also, the ending --- line in metadata blocks appears to be a 6861 setext header, but should not be folded." 6862 (save-excursion 6863 (goto-char (point-min)) 6864 ;; Unhide any false positives in metadata blocks 6865 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) 6866 (let ((body (progn (forward-line) 6867 (markdown-text-property-at-point 6868 'markdown-yaml-metadata-section)))) 6869 (when body 6870 (let ((end (progn (goto-char (cl-second body)) 6871 (markdown-text-property-at-point 6872 'markdown-yaml-metadata-end)))) 6873 (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) 6874 ;; Hide any false positives in code blocks 6875 (unless (outline-on-heading-p) 6876 (outline-next-visible-heading 1)) 6877 (while (< (point) (point-max)) 6878 (when (markdown-code-block-at-point-p) 6879 (outline-flag-region (1- (point-at-bol)) (point-at-eol) t)) 6880 (outline-next-visible-heading 1)))) 6881 6882 (defvar markdown-cycle-global-status 1) 6883 (defvar markdown-cycle-subtree-status nil) 6884 6885 (defun markdown-next-preface () 6886 (let (finish) 6887 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") 6888 nil 'move)) 6889 (unless (markdown-code-block-at-point-p) 6890 (goto-char (match-beginning 0)) 6891 (setq finish t)))) 6892 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) 6893 (forward-char -1))) 6894 6895 (defun markdown-show-entry () 6896 (save-excursion 6897 (outline-back-to-heading t) 6898 (outline-flag-region (1- (point)) 6899 (progn 6900 (markdown-next-preface) 6901 (if (= 1 (- (point-max) (point))) 6902 (point-max) 6903 (point))) 6904 nil))) 6905 6906 ;; This function was originally derived from `org-cycle' from org.el. 6907 (defun markdown-cycle (&optional arg) 6908 "Visibility cycling for Markdown mode. 6909 This function is called with a `\\[universal-argument]' or if ARG is t, perform 6910 global visibility cycling. If the point is at an atx-style header, cycle 6911 visibility of the corresponding subtree. Otherwise, indent the current line 6912 or insert a tab, as appropriate, by calling `indent-for-tab-command'." 6913 (interactive "P") 6914 (cond 6915 6916 ;; Global cycling 6917 (arg 6918 (cond 6919 ;; Move from overview to contents 6920 ((and (eq last-command this-command) 6921 (eq markdown-cycle-global-status 2)) 6922 (outline-hide-sublevels 1) 6923 (message "CONTENTS") 6924 (setq markdown-cycle-global-status 3) 6925 (markdown-outline-fix-visibility)) 6926 ;; Move from contents to all 6927 ((and (eq last-command this-command) 6928 (eq markdown-cycle-global-status 3)) 6929 (outline-show-all) 6930 (message "SHOW ALL") 6931 (setq markdown-cycle-global-status 1)) 6932 ;; Defaults to overview 6933 (t 6934 (outline-hide-body) 6935 (message "OVERVIEW") 6936 (setq markdown-cycle-global-status 2) 6937 (markdown-outline-fix-visibility)))) 6938 6939 ;; At a heading: rotate between three different views 6940 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) 6941 (markdown-back-to-heading) 6942 (let ((goal-column 0) eoh eol eos) 6943 ;; Determine boundaries 6944 (save-excursion 6945 (markdown-back-to-heading) 6946 (save-excursion 6947 (beginning-of-line 2) 6948 (while (and (not (eobp)) ;; this is like `next-line' 6949 (get-char-property (1- (point)) 'invisible)) 6950 (beginning-of-line 2)) (setq eol (point))) 6951 (markdown-end-of-heading) (setq eoh (point)) 6952 (markdown-end-of-subtree t) 6953 (skip-chars-forward " \t\n") 6954 (beginning-of-line 1) ; in case this is an item 6955 (setq eos (1- (point)))) 6956 ;; Find out what to do next and set `this-command' 6957 (cond 6958 ;; Nothing is hidden behind this heading 6959 ((= eos eoh) 6960 (message "EMPTY ENTRY") 6961 (setq markdown-cycle-subtree-status nil)) 6962 ;; Entire subtree is hidden in one line: open it 6963 ((>= eol eos) 6964 (markdown-show-entry) 6965 (outline-show-children) 6966 (message "CHILDREN") 6967 (setq markdown-cycle-subtree-status 'children)) 6968 ;; We just showed the children, now show everything. 6969 ((and (eq last-command this-command) 6970 (eq markdown-cycle-subtree-status 'children)) 6971 (outline-show-subtree) 6972 (message "SUBTREE") 6973 (setq markdown-cycle-subtree-status 'subtree)) 6974 ;; Default action: hide the subtree. 6975 (t 6976 (outline-hide-subtree) 6977 (message "FOLDED") 6978 (setq markdown-cycle-subtree-status 'folded))))) 6979 6980 ;; In a table, move forward by one cell 6981 ((markdown-table-at-point-p) 6982 (call-interactively #'markdown-table-forward-cell)) 6983 6984 ;; Otherwise, indent as appropriate 6985 (t 6986 (indent-for-tab-command)))) 6987 6988 (defun markdown-shifttab () 6989 "Handle S-TAB keybinding based on context. 6990 When in a table, move backward one cell. 6991 Otherwise, cycle global heading visibility by calling 6992 `markdown-cycle' with argument t." 6993 (interactive) 6994 (cond ((markdown-table-at-point-p) 6995 (call-interactively #'markdown-table-backward-cell)) 6996 (t (markdown-cycle t)))) 6997 6998 (defun markdown-outline-level () 6999 "Return the depth to which a statement is nested in the outline." 7000 (cond 7001 ((and (match-beginning 0) 7002 (markdown-code-block-at-pos (match-beginning 0))) 7003 7) ;; Only 6 header levels are defined. 7004 ((match-end 2) 1) 7005 ((match-end 3) 2) 7006 ((match-end 4) 7007 (length (markdown-trim-whitespace (match-string-no-properties 4)))))) 7008 7009 (defun markdown-promote-subtree (&optional arg) 7010 "Promote the current subtree of ATX headings. 7011 Note that Markdown does not support heading levels higher than 7012 six and therefore level-six headings will not be promoted 7013 further. If ARG is non-nil promote the heading, otherwise 7014 demote." 7015 (interactive "*P") 7016 (save-excursion 7017 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) 7018 (re-search-backward markdown-regex-header-atx nil t)) 7019 (not (markdown-code-block-at-point-p))) 7020 (let ((level (length (match-string 1))) 7021 (promote-or-demote (if arg 1 -1)) 7022 (remove 't)) 7023 (markdown-cycle-atx promote-or-demote remove) 7024 (catch 'end-of-subtree 7025 (while (and (markdown-next-heading) 7026 (looking-at markdown-regex-header-atx)) 7027 ;; Exit if this not a higher level heading; promote otherwise. 7028 (if (and (looking-at markdown-regex-header-atx) 7029 (<= (length (match-string-no-properties 1)) level)) 7030 (throw 'end-of-subtree nil) 7031 (markdown-cycle-atx promote-or-demote remove)))))))) 7032 7033 (defun markdown-demote-subtree () 7034 "Demote the current subtree of ATX headings." 7035 (interactive) 7036 (markdown-promote-subtree t)) 7037 7038 (defun markdown-move-subtree-up () 7039 "Move the current subtree of ATX headings up." 7040 (interactive) 7041 (outline-move-subtree-up 1)) 7042 7043 (defun markdown-move-subtree-down () 7044 "Move the current subtree of ATX headings down." 7045 (interactive) 7046 (outline-move-subtree-down 1)) 7047 7048 (defun markdown-outline-next () 7049 "Move to next list item, when in a list, or next visible heading." 7050 (interactive) 7051 (let ((bounds (markdown-next-list-item-bounds))) 7052 (if bounds 7053 (goto-char (nth 0 bounds)) 7054 (markdown-next-visible-heading 1)))) 7055 7056 (defun markdown-outline-previous () 7057 "Move to previous list item, when in a list, or previous visible heading." 7058 (interactive) 7059 (let ((bounds (markdown-prev-list-item-bounds))) 7060 (if bounds 7061 (goto-char (nth 0 bounds)) 7062 (markdown-previous-visible-heading 1)))) 7063 7064 (defun markdown-outline-next-same-level () 7065 "Move to next list item or heading of same level." 7066 (interactive) 7067 (let ((bounds (markdown-cur-list-item-bounds))) 7068 (if bounds 7069 (markdown-next-list-item (nth 3 bounds)) 7070 (markdown-forward-same-level 1)))) 7071 7072 (defun markdown-outline-previous-same-level () 7073 "Move to previous list item or heading of same level." 7074 (interactive) 7075 (let ((bounds (markdown-cur-list-item-bounds))) 7076 (if bounds 7077 (markdown-prev-list-item (nth 3 bounds)) 7078 (markdown-backward-same-level 1)))) 7079 7080 (defun markdown-outline-up () 7081 "Move to previous list item, when in a list, or previous heading." 7082 (interactive) 7083 (unless (markdown-up-list) 7084 (markdown-up-heading 1))) 7085 7086 7087 ;;; Marking and Narrowing ===================================================== 7088 7089 (defun markdown-mark-paragraph () 7090 "Put mark at end of this block, point at beginning. 7091 The block marked is the one that contains point or follows point. 7092 7093 Interactively, if this command is repeated or (in Transient Mark 7094 mode) if the mark is active, it marks the next block after the 7095 ones already marked." 7096 (interactive) 7097 (if (or (and (eq last-command this-command) (mark t)) 7098 (and transient-mark-mode mark-active)) 7099 (set-mark 7100 (save-excursion 7101 (goto-char (mark)) 7102 (markdown-forward-paragraph) 7103 (point))) 7104 (let ((beginning-of-defun-function #'markdown-backward-paragraph) 7105 (end-of-defun-function #'markdown-forward-paragraph)) 7106 (mark-defun)))) 7107 7108 (defun markdown-mark-block () 7109 "Put mark at end of this block, point at beginning. 7110 The block marked is the one that contains point or follows point. 7111 7112 Interactively, if this command is repeated or (in Transient Mark 7113 mode) if the mark is active, it marks the next block after the 7114 ones already marked." 7115 (interactive) 7116 (if (or (and (eq last-command this-command) (mark t)) 7117 (and transient-mark-mode mark-active)) 7118 (set-mark 7119 (save-excursion 7120 (goto-char (mark)) 7121 (markdown-forward-block) 7122 (point))) 7123 (let ((beginning-of-defun-function #'markdown-backward-block) 7124 (end-of-defun-function #'markdown-forward-block)) 7125 (mark-defun)))) 7126 7127 (defun markdown-narrow-to-block () 7128 "Make text outside current block invisible. 7129 The current block is the one that contains point or follows point." 7130 (interactive) 7131 (let ((beginning-of-defun-function #'markdown-backward-block) 7132 (end-of-defun-function #'markdown-forward-block)) 7133 (narrow-to-defun))) 7134 7135 (defun markdown-mark-text-block () 7136 "Put mark at end of this plain text block, point at beginning. 7137 The block marked is the one that contains point or follows point. 7138 7139 Interactively, if this command is repeated or (in Transient Mark 7140 mode) if the mark is active, it marks the next block after the 7141 ones already marked." 7142 (interactive) 7143 (if (or (and (eq last-command this-command) (mark t)) 7144 (and transient-mark-mode mark-active)) 7145 (set-mark 7146 (save-excursion 7147 (goto-char (mark)) 7148 (markdown-end-of-text-block) 7149 (point))) 7150 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) 7151 (end-of-defun-function #'markdown-end-of-text-block)) 7152 (mark-defun)))) 7153 7154 (defun markdown-mark-page () 7155 "Put mark at end of this top level section, point at beginning. 7156 The top level section marked is the one that contains point or 7157 follows point. 7158 7159 Interactively, if this command is repeated or (in Transient Mark 7160 mode) if the mark is active, it marks the next page after the 7161 ones already marked." 7162 (interactive) 7163 (if (or (and (eq last-command this-command) (mark t)) 7164 (and transient-mark-mode mark-active)) 7165 (set-mark 7166 (save-excursion 7167 (goto-char (mark)) 7168 (markdown-forward-page) 7169 (point))) 7170 (let ((beginning-of-defun-function #'markdown-backward-page) 7171 (end-of-defun-function #'markdown-forward-page)) 7172 (mark-defun)))) 7173 7174 (defun markdown-narrow-to-page () 7175 "Make text outside current top level section invisible. 7176 The current section is the one that contains point or follows point." 7177 (interactive) 7178 (let ((beginning-of-defun-function #'markdown-backward-page) 7179 (end-of-defun-function #'markdown-forward-page)) 7180 (narrow-to-defun))) 7181 7182 (defun markdown-mark-subtree () 7183 "Mark the current subtree. 7184 This puts point at the start of the current subtree, and mark at the end." 7185 (interactive) 7186 (let ((beg)) 7187 (if (markdown-heading-at-point) 7188 (beginning-of-line) 7189 (markdown-previous-visible-heading 1)) 7190 (setq beg (point)) 7191 (markdown-end-of-subtree) 7192 (push-mark (point) nil t) 7193 (goto-char beg))) 7194 7195 (defun markdown-narrow-to-subtree () 7196 "Narrow buffer to the current subtree." 7197 (interactive) 7198 (save-excursion 7199 (save-match-data 7200 (narrow-to-region 7201 (progn (markdown-back-to-heading-over-code-block t) (point)) 7202 (progn (markdown-end-of-subtree) 7203 (if (and (markdown-heading-at-point) (not (eobp))) 7204 (backward-char 1)) 7205 (point)))))) 7206 7207 7208 ;;; Generic Structure Editing, Completion, and Cycling Commands =============== 7209 7210 (defun markdown-move-up () 7211 "Move thing at point up. 7212 When in a list item, call `markdown-move-list-item-up'. 7213 When in a table, call `markdown-table-move-row-up'. 7214 Otherwise, move the current heading subtree up with 7215 `markdown-move-subtree-up'." 7216 (interactive) 7217 (cond 7218 ((markdown-list-item-at-point-p) 7219 (call-interactively #'markdown-move-list-item-up)) 7220 ((markdown-table-at-point-p) 7221 (call-interactively #'markdown-table-move-row-up)) 7222 (t 7223 (call-interactively #'markdown-move-subtree-up)))) 7224 7225 (defun markdown-move-down () 7226 "Move thing at point down. 7227 When in a list item, call `markdown-move-list-item-down'. 7228 Otherwise, move the current heading subtree up with 7229 `markdown-move-subtree-down'." 7230 (interactive) 7231 (cond 7232 ((markdown-list-item-at-point-p) 7233 (call-interactively #'markdown-move-list-item-down)) 7234 ((markdown-table-at-point-p) 7235 (call-interactively #'markdown-table-move-row-down)) 7236 (t 7237 (call-interactively #'markdown-move-subtree-down)))) 7238 7239 (defun markdown-promote () 7240 "Promote or move element at point to the left. 7241 Depending on the context, this function will promote a heading or 7242 list item at the point, move a table column to the left, or cycle 7243 markup." 7244 (interactive) 7245 (let (bounds) 7246 (cond 7247 ;; Promote atx heading subtree 7248 ((thing-at-point-looking-at markdown-regex-header-atx) 7249 (markdown-promote-subtree)) 7250 ;; Promote setext heading 7251 ((thing-at-point-looking-at markdown-regex-header-setext) 7252 (markdown-cycle-setext -1)) 7253 ;; Promote horizontal rule 7254 ((thing-at-point-looking-at markdown-regex-hr) 7255 (markdown-cycle-hr -1)) 7256 ;; Promote list item 7257 ((setq bounds (markdown-cur-list-item-bounds)) 7258 (markdown-promote-list-item bounds)) 7259 ;; Move table column to the left 7260 ((markdown-table-at-point-p) 7261 (call-interactively #'markdown-table-move-column-left)) 7262 ;; Promote bold 7263 ((thing-at-point-looking-at markdown-regex-bold) 7264 (markdown-cycle-bold)) 7265 ;; Promote italic 7266 ((thing-at-point-looking-at markdown-regex-italic) 7267 (markdown-cycle-italic)) 7268 (t 7269 (user-error "Nothing to promote at point"))))) 7270 7271 (defun markdown-demote () 7272 "Demote or move element at point to the right. 7273 Depending on the context, this function will demote a heading or 7274 list item at the point, move a table column to the right, or cycle 7275 or remove markup." 7276 (interactive) 7277 (let (bounds) 7278 (cond 7279 ;; Demote atx heading subtree 7280 ((thing-at-point-looking-at markdown-regex-header-atx) 7281 (markdown-demote-subtree)) 7282 ;; Demote setext heading 7283 ((thing-at-point-looking-at markdown-regex-header-setext) 7284 (markdown-cycle-setext 1)) 7285 ;; Demote horizontal rule 7286 ((thing-at-point-looking-at markdown-regex-hr) 7287 (markdown-cycle-hr 1)) 7288 ;; Demote list item 7289 ((setq bounds (markdown-cur-list-item-bounds)) 7290 (markdown-demote-list-item bounds)) 7291 ;; Move table column to the right 7292 ((markdown-table-at-point-p) 7293 (call-interactively #'markdown-table-move-column-right)) 7294 ;; Demote bold 7295 ((thing-at-point-looking-at markdown-regex-bold) 7296 (markdown-cycle-bold)) 7297 ;; Demote italic 7298 ((thing-at-point-looking-at markdown-regex-italic) 7299 (markdown-cycle-italic)) 7300 (t 7301 (user-error "Nothing to demote at point"))))) 7302 7303 7304 ;;; Commands ================================================================== 7305 7306 (defun markdown (&optional output-buffer-name) 7307 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. 7308 The output buffer name defaults to `markdown-output-buffer-name'. 7309 Return the name of the output buffer used." 7310 (interactive) 7311 (save-window-excursion 7312 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) 7313 ((listp markdown-command) markdown-command))) 7314 (command (car-safe commands)) 7315 (command-args (cdr-safe commands)) 7316 begin-region end-region) 7317 (if (use-region-p) 7318 (setq begin-region (region-beginning) 7319 end-region (region-end)) 7320 (setq begin-region (point-min) 7321 end-region (point-max))) 7322 7323 (unless output-buffer-name 7324 (setq output-buffer-name markdown-output-buffer-name)) 7325 (when (and (stringp command) (not (executable-find command))) 7326 (user-error "Markdown command %s is not found" command)) 7327 (let ((exit-code 7328 (cond 7329 ;; Handle case when `markdown-command' does not read from stdin 7330 ((and (stringp command) markdown-command-needs-filename) 7331 (if (not buffer-file-name) 7332 (user-error "Must be visiting a file") 7333 ;; Don’t use ‘shell-command’ because it’s not guaranteed to 7334 ;; return the exit code of the process. 7335 (let ((command (if (listp markdown-command) 7336 (string-join markdown-command " ") 7337 markdown-command))) 7338 (shell-command-on-region 7339 ;; Pass an empty region so that stdin is empty. 7340 (point) (point) 7341 (concat command " " 7342 (shell-quote-argument buffer-file-name)) 7343 output-buffer-name)))) 7344 ;; Pass region to `markdown-command' via stdin 7345 (t 7346 (let ((buf (get-buffer-create output-buffer-name))) 7347 (with-current-buffer buf 7348 (setq buffer-read-only nil) 7349 (erase-buffer)) 7350 (if (stringp command) 7351 (if (not (null command-args)) 7352 (apply #'call-process-region begin-region end-region command nil buf nil command-args) 7353 (call-process-region begin-region end-region command nil buf)) 7354 (funcall markdown-command begin-region end-region buf) 7355 ;; If the ‘markdown-command’ function didn’t signal an 7356 ;; error, assume it succeeded by binding ‘exit-code’ to 0. 7357 0)))))) 7358 ;; The exit code can be a signal description string, so don’t use ‘=’ 7359 ;; or ‘zerop’. 7360 (unless (eq exit-code 0) 7361 (user-error "%s failed with exit code %s" 7362 markdown-command exit-code)))) 7363 output-buffer-name)) 7364 7365 (defun markdown-standalone (&optional output-buffer-name) 7366 "Special function to provide standalone HTML output. 7367 Insert the output in the buffer named OUTPUT-BUFFER-NAME." 7368 (interactive) 7369 (setq output-buffer-name (markdown output-buffer-name)) 7370 (with-current-buffer output-buffer-name 7371 (set-buffer output-buffer-name) 7372 (unless (markdown-output-standalone-p) 7373 (markdown-add-xhtml-header-and-footer output-buffer-name)) 7374 (goto-char (point-min)) 7375 (html-mode)) 7376 output-buffer-name) 7377 7378 (defun markdown-other-window (&optional output-buffer-name) 7379 "Run `markdown-command' on current buffer and display in other window. 7380 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7381 that name." 7382 (interactive) 7383 (markdown-display-buffer-other-window 7384 (markdown-standalone output-buffer-name))) 7385 7386 (defun markdown-output-standalone-p () 7387 "Determine whether `markdown-command' output is standalone XHTML. 7388 Standalone XHTML output is identified by an occurrence of 7389 `markdown-xhtml-standalone-regexp' in the first five lines of output." 7390 (save-excursion 7391 (goto-char (point-min)) 7392 (save-match-data 7393 (re-search-forward 7394 markdown-xhtml-standalone-regexp 7395 (save-excursion (goto-char (point-min)) (forward-line 4) (point)) 7396 t)))) 7397 7398 (defun markdown-stylesheet-link-string (stylesheet-path) 7399 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" 7400 (or (and (string-prefix-p "~" stylesheet-path) 7401 (expand-file-name stylesheet-path)) 7402 stylesheet-path) 7403 "\" />")) 7404 7405 (defun markdown-add-xhtml-header-and-footer (title) 7406 "Wrap XHTML header and footer with given TITLE around current buffer." 7407 (goto-char (point-min)) 7408 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" 7409 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" 7410 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" 7411 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" 7412 "<head>\n<title>") 7413 (insert title) 7414 (insert "</title>\n") 7415 (unless (= (length markdown-content-type) 0) 7416 (insert 7417 (format 7418 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" 7419 markdown-content-type 7420 (or (and markdown-coding-system 7421 (coding-system-get markdown-coding-system 7422 'mime-charset)) 7423 (coding-system-get buffer-file-coding-system 7424 'mime-charset) 7425 "utf-8")))) 7426 (if (> (length markdown-css-paths) 0) 7427 (insert (mapconcat #'markdown-stylesheet-link-string 7428 markdown-css-paths "\n"))) 7429 (when (> (length markdown-xhtml-header-content) 0) 7430 (insert markdown-xhtml-header-content)) 7431 (insert "\n</head>\n\n" 7432 "<body>\n\n") 7433 (when (> (length markdown-xhtml-body-preamble) 0) 7434 (insert markdown-xhtml-body-preamble "\n")) 7435 (goto-char (point-max)) 7436 (when (> (length markdown-xhtml-body-epilogue) 0) 7437 (insert "\n" markdown-xhtml-body-epilogue)) 7438 (insert "\n" 7439 "</body>\n" 7440 "</html>\n")) 7441 7442 (defun markdown-preview (&optional output-buffer-name) 7443 "Run `markdown-command' on the current buffer and view output in browser. 7444 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7445 that name." 7446 (interactive) 7447 (browse-url-of-buffer 7448 (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) 7449 7450 (defun markdown-export-file-name (&optional extension) 7451 "Attempt to generate a filename for Markdown output. 7452 The file extension will be EXTENSION if given, or .html by default. 7453 If the current buffer is visiting a file, we construct a new 7454 output filename based on that filename. Otherwise, return nil." 7455 (when (buffer-file-name) 7456 (unless extension 7457 (setq extension ".html")) 7458 (let ((candidate 7459 (concat 7460 (cond 7461 ((buffer-file-name) 7462 (file-name-sans-extension (buffer-file-name))) 7463 (t (buffer-name))) 7464 extension))) 7465 (cond 7466 ((equal candidate (buffer-file-name)) 7467 (concat candidate extension)) 7468 (t 7469 candidate))))) 7470 7471 (defun markdown-export (&optional output-file) 7472 "Run Markdown on the current buffer, save to file, and return the filename. 7473 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename 7474 generated by `markdown-export-file-name', which will be constructed using the 7475 current filename, but with the extension removed and replaced with .html." 7476 (interactive) 7477 (unless output-file 7478 (setq output-file (markdown-export-file-name ".html"))) 7479 (when output-file 7480 (let* ((init-buf (current-buffer)) 7481 (init-point (point)) 7482 (init-buf-string (buffer-string)) 7483 (output-buffer (find-file-noselect output-file)) 7484 (output-buffer-name (buffer-name output-buffer))) 7485 (run-hooks 'markdown-before-export-hook) 7486 (markdown-standalone output-buffer-name) 7487 (with-current-buffer output-buffer 7488 (run-hooks 'markdown-after-export-hook) 7489 (save-buffer) 7490 (when markdown-export-kill-buffer (kill-buffer))) 7491 ;; if modified, restore initial buffer 7492 (when (buffer-modified-p init-buf) 7493 (erase-buffer) 7494 (insert init-buf-string) 7495 (save-buffer) 7496 (goto-char init-point)) 7497 output-file))) 7498 7499 (defun markdown-export-and-preview () 7500 "Export to XHTML using `markdown-export' and browse the resulting file." 7501 (interactive) 7502 (browse-url-of-file (markdown-export))) 7503 7504 (defvar-local markdown-live-preview-buffer nil 7505 "Buffer used to preview markdown output in `markdown-live-preview-export'.") 7506 7507 (defvar-local markdown-live-preview-source-buffer nil 7508 "Source buffer from which current buffer was generated. 7509 This is the inverse of `markdown-live-preview-buffer'.") 7510 7511 (defvar markdown-live-preview-currently-exporting nil) 7512 7513 (defun markdown-live-preview-get-filename () 7514 "Standardize the filename exported by `markdown-live-preview-export'." 7515 (markdown-export-file-name ".html")) 7516 7517 (defun markdown-live-preview-window-eww (file) 7518 "Preview FILE with eww. 7519 To be used with `markdown-live-preview-window-function'." 7520 (eww-open-file file) 7521 (get-buffer "*eww*")) 7522 7523 (defun markdown-visual-lines-between-points (beg end) 7524 (save-excursion 7525 (goto-char beg) 7526 (cl-loop with count = 0 7527 while (progn (end-of-visual-line) 7528 (and (< (point) end) (line-move-visual 1 t))) 7529 do (cl-incf count) 7530 finally return count))) 7531 7532 (defun markdown-live-preview-window-serialize (buf) 7533 "Get window point and scroll data for all windows displaying BUF." 7534 (when (buffer-live-p buf) 7535 (with-current-buffer buf 7536 (mapcar 7537 (lambda (win) 7538 (with-selected-window win 7539 (let* ((start (window-start)) 7540 (pt (window-point)) 7541 (pt-or-sym (cond ((= pt (point-min)) 'min) 7542 ((= pt (point-max)) 'max) 7543 (t pt))) 7544 (diff (markdown-visual-lines-between-points 7545 start pt))) 7546 (list win pt-or-sym diff)))) 7547 (get-buffer-window-list buf))))) 7548 7549 (defun markdown-get-point-back-lines (pt num-lines) 7550 (save-excursion 7551 (goto-char pt) 7552 (line-move-visual (- num-lines) t) 7553 ;; in testing, can occasionally overshoot the number of lines to traverse 7554 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) 7555 (when (> actual-num-lines num-lines) 7556 (line-move-visual (- actual-num-lines num-lines) t))) 7557 (point))) 7558 7559 (defun markdown-live-preview-window-deserialize (window-posns) 7560 "Apply window point and scroll data from WINDOW-POSNS. 7561 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." 7562 (cl-destructuring-bind (win pt-or-sym diff) window-posns 7563 (when (window-live-p win) 7564 (with-current-buffer markdown-live-preview-buffer 7565 (set-window-buffer win (current-buffer)) 7566 (cl-destructuring-bind (actual-pt actual-diff) 7567 (cl-case pt-or-sym 7568 (min (list (point-min) 0)) 7569 (max (list (point-max) diff)) 7570 (t (list pt-or-sym diff))) 7571 (set-window-start 7572 win (markdown-get-point-back-lines actual-pt actual-diff)) 7573 (set-window-point win actual-pt)))))) 7574 7575 (defun markdown-live-preview-export () 7576 "Export to XHTML using `markdown-export'. 7577 Browse the resulting file within Emacs using 7578 `markdown-live-preview-window-function' Return the buffer 7579 displaying the rendered output." 7580 (interactive) 7581 (let ((filename (markdown-live-preview-get-filename))) 7582 (when filename 7583 (let* ((markdown-live-preview-currently-exporting t) 7584 (cur-buf (current-buffer)) 7585 (export-file (markdown-export filename)) 7586 ;; get positions in all windows currently displaying output buffer 7587 (window-data 7588 (markdown-live-preview-window-serialize 7589 markdown-live-preview-buffer))) 7590 (save-window-excursion 7591 (let ((output-buffer 7592 (funcall markdown-live-preview-window-function export-file))) 7593 (with-current-buffer output-buffer 7594 (setq markdown-live-preview-source-buffer cur-buf) 7595 (add-hook 'kill-buffer-hook 7596 #'markdown-live-preview-remove-on-kill t t)) 7597 (with-current-buffer cur-buf 7598 (setq markdown-live-preview-buffer output-buffer)))) 7599 (with-current-buffer cur-buf 7600 ;; reset all windows displaying output buffer to where they were, 7601 ;; now with the new output 7602 (mapc #'markdown-live-preview-window-deserialize window-data) 7603 ;; delete html editing buffer 7604 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) 7605 (when (and export-file (file-exists-p export-file) 7606 (eq markdown-live-preview-delete-export 7607 'delete-on-export)) 7608 (delete-file export-file)) 7609 markdown-live-preview-buffer))))) 7610 7611 (defun markdown-live-preview-remove () 7612 (when (buffer-live-p markdown-live-preview-buffer) 7613 (kill-buffer markdown-live-preview-buffer)) 7614 (setq markdown-live-preview-buffer nil) 7615 ;; if set to 'delete-on-export, the output has already been deleted 7616 (when (eq markdown-live-preview-delete-export 'delete-on-destroy) 7617 (let ((outfile-name (markdown-live-preview-get-filename))) 7618 (when (and outfile-name (file-exists-p outfile-name)) 7619 (delete-file outfile-name))))) 7620 7621 (defun markdown-get-other-window () 7622 "Find another window to display preview or output content." 7623 (cond 7624 ((memq markdown-split-window-direction '(vertical below)) 7625 (or (window-in-direction 'below) (split-window-vertically))) 7626 ((memq markdown-split-window-direction '(horizontal right)) 7627 (or (window-in-direction 'right) (split-window-horizontally))) 7628 (t (split-window-sensibly (get-buffer-window))))) 7629 7630 (defun markdown-display-buffer-other-window (buf) 7631 "Display preview or output buffer BUF in another window." 7632 (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) 7633 (display-buffer buf) 7634 (let ((cur-buf (current-buffer)) 7635 (window (markdown-get-other-window))) 7636 (set-window-buffer window buf) 7637 (set-buffer cur-buf)))) 7638 7639 (defun markdown-live-preview-if-markdown () 7640 (when (and (derived-mode-p 'markdown-mode) 7641 markdown-live-preview-mode) 7642 (unless markdown-live-preview-currently-exporting 7643 (if (buffer-live-p markdown-live-preview-buffer) 7644 (markdown-live-preview-export) 7645 (markdown-display-buffer-other-window 7646 (markdown-live-preview-export)))))) 7647 7648 (defun markdown-live-preview-remove-on-kill () 7649 (cond ((and (derived-mode-p 'markdown-mode) 7650 markdown-live-preview-mode) 7651 (markdown-live-preview-remove)) 7652 (markdown-live-preview-source-buffer 7653 (with-current-buffer markdown-live-preview-source-buffer 7654 (setq markdown-live-preview-buffer nil)) 7655 (setq markdown-live-preview-source-buffer nil)))) 7656 7657 (defun markdown-live-preview-switch-to-output () 7658 "Switch to output buffer." 7659 (interactive) 7660 "Turn on `markdown-live-preview-mode' if not already on, and switch to its 7661 output buffer in another window." 7662 (if markdown-live-preview-mode 7663 (markdown-display-buffer-other-window (markdown-live-preview-export))) 7664 (markdown-live-preview-mode)) 7665 7666 (defun markdown-live-preview-re-export () 7667 "Re export source buffer." 7668 (interactive) 7669 "If the current buffer is a buffer displaying the exported version of a 7670 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and 7671 update this buffer's contents." 7672 (when markdown-live-preview-source-buffer 7673 (with-current-buffer markdown-live-preview-source-buffer 7674 (markdown-live-preview-export)))) 7675 7676 (defun markdown-open () 7677 "Open file for the current buffer with `markdown-open-command'." 7678 (interactive) 7679 (unless markdown-open-command 7680 (user-error "Variable `markdown-open-command' must be set")) 7681 (if (stringp markdown-open-command) 7682 (if (not buffer-file-name) 7683 (user-error "Must be visiting a file") 7684 (save-buffer) 7685 (let ((exit-code (call-process markdown-open-command nil nil nil 7686 buffer-file-name))) 7687 ;; The exit code can be a signal description string, so don’t use ‘=’ 7688 ;; or ‘zerop’. 7689 (unless (eq exit-code 0) 7690 (user-error "%s failed with exit code %s" 7691 markdown-open-command exit-code)))) 7692 (funcall markdown-open-command)) 7693 nil) 7694 7695 (defun markdown-kill-ring-save () 7696 "Run Markdown on file and store output in the kill ring." 7697 (interactive) 7698 (save-window-excursion 7699 (markdown) 7700 (with-current-buffer markdown-output-buffer-name 7701 (kill-ring-save (point-min) (point-max))))) 7702 7703 7704 ;;; Links ===================================================================== 7705 7706 (defun markdown-backward-to-link-start () 7707 "Backward link start position if current position is in link title." 7708 ;; Issue #305 7709 (when (eq (get-text-property (point) 'face) 'markdown-link-face) 7710 (skip-chars-backward "^[") 7711 (forward-char -1))) 7712 7713 (defun markdown-link-p () 7714 "Return non-nil when `point' is at a non-wiki link. 7715 See `markdown-wiki-link-p' for more information." 7716 (save-excursion 7717 (let ((case-fold-search nil)) 7718 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) 7719 (markdown-backward-to-link-start) 7720 (or (thing-at-point-looking-at markdown-regex-link-inline) 7721 (thing-at-point-looking-at markdown-regex-link-reference) 7722 (thing-at-point-looking-at markdown-regex-uri) 7723 (thing-at-point-looking-at markdown-regex-angle-uri)))))) 7724 7725 (defun markdown-link-at-pos (pos) 7726 "Return properties of link or image at position POS. 7727 Value is a list of elements describing the link: 7728 0. beginning position 7729 1. end position 7730 2. link text 7731 3. URL 7732 4. reference label 7733 5. title text 7734 6. bang (nil or \"!\")" 7735 (save-excursion 7736 (goto-char pos) 7737 (markdown-backward-to-link-start) 7738 (let (begin end text url reference title bang) 7739 (cond 7740 ;; Inline image or link at point. 7741 ((thing-at-point-looking-at markdown-regex-link-inline) 7742 (setq bang (match-string-no-properties 1) 7743 begin (match-beginning 0) 7744 end (match-end 0) 7745 text (match-string-no-properties 3) 7746 url (match-string-no-properties 6)) 7747 (if (match-end 7) 7748 (setq title (substring (match-string-no-properties 7) 1 -1)) 7749 ;; #408 URL contains close parenthesis case 7750 (goto-char (match-beginning 5)) 7751 (let ((paren-end (scan-sexps (point) 1))) 7752 (when (and paren-end (< end paren-end)) 7753 (setq url (buffer-substring (match-beginning 6) (1- paren-end))))))) 7754 ;; Reference link at point. 7755 ((or (thing-at-point-looking-at markdown-regex-link-inline) 7756 (thing-at-point-looking-at markdown-regex-link-reference)) 7757 (setq bang (match-string-no-properties 1) 7758 begin (match-beginning 0) 7759 end (match-end 0) 7760 text (match-string-no-properties 3)) 7761 (when (char-equal (char-after (match-beginning 5)) ?\[) 7762 (setq reference (match-string-no-properties 6)))) 7763 ;; Angle bracket URI at point. 7764 ((thing-at-point-looking-at markdown-regex-angle-uri) 7765 (setq begin (match-beginning 0) 7766 end (match-end 0) 7767 url (match-string-no-properties 2))) 7768 ;; Plain URI at point. 7769 ((thing-at-point-looking-at markdown-regex-uri) 7770 (setq begin (match-beginning 0) 7771 end (match-end 0) 7772 url (match-string-no-properties 1)))) 7773 (list begin end text url reference title bang)))) 7774 7775 (defun markdown-link-url () 7776 "Return the URL part of the regular (non-wiki) link at point. 7777 Works with both inline and reference style links, and with images. 7778 If point is not at a link or the link reference is not defined 7779 returns nil." 7780 (let* ((values (markdown-link-at-pos (point))) 7781 (text (nth 2 values)) 7782 (url (nth 3 values)) 7783 (ref (nth 4 values))) 7784 (or url (and ref (car (markdown-reference-definition 7785 (downcase (if (string= ref "") text ref)))))))) 7786 7787 (defun markdown--browse-url (url) 7788 (let* ((struct (url-generic-parse-url url)) 7789 (full (url-fullness struct)) 7790 (file url)) 7791 ;; Parse URL, determine fullness, strip query string 7792 (setq file (car (url-path-and-query struct))) 7793 ;; Open full URLs in browser, files in Emacs 7794 (if full 7795 (browse-url url) 7796 (when (and file (> (length file) 0)) 7797 (let ((link-file (funcall markdown-translate-filename-function file))) 7798 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) 7799 (if (functionp markdown-open-image-command) 7800 (funcall markdown-open-image-command link-file) 7801 (process-file markdown-open-image-command nil nil nil link-file)) 7802 (find-file link-file))))))) 7803 7804 (defun markdown-follow-link-at-point (&optional event) 7805 "Open the non-wiki link at point or EVENT. 7806 If the link is a complete URL, open in browser with `browse-url'. 7807 Otherwise, open with `find-file' after stripping anchor and/or query string. 7808 Translate filenames using `markdown-filename-translate-function'." 7809 (interactive (list last-command-event)) 7810 (save-excursion 7811 (if event (posn-set-point (event-start event))) 7812 (if (markdown-link-p) 7813 (markdown--browse-url (markdown-link-url)) 7814 (user-error "Point is not at a Markdown link or URL")))) 7815 7816 (defun markdown-fontify-inline-links (last) 7817 "Add text properties to next inline link from point to LAST." 7818 (when (markdown-match-generic-links last nil) 7819 (let* ((link-start (match-beginning 3)) 7820 (link-end (match-end 3)) 7821 (url-start (match-beginning 6)) 7822 (url-end (match-end 6)) 7823 (url (match-string-no-properties 6)) 7824 (title-start (match-beginning 7)) 7825 (title-end (match-end 7)) 7826 (title (match-string-no-properties 7)) 7827 ;; Markup part 7828 (mp (list 'face 'markdown-markup-face 7829 'invisible 'markdown-markup 7830 'rear-nonsticky t 7831 'font-lock-multiline t)) 7832 ;; Link part (without face) 7833 (lp (list 'keymap markdown-mode-mouse-map 7834 'mouse-face 'markdown-highlight-face 7835 'font-lock-multiline t 7836 'help-echo (if title (concat title "\n" url) url))) 7837 ;; URL part 7838 (up (list 'keymap markdown-mode-mouse-map 7839 'face 'markdown-url-face 7840 'invisible 'markdown-markup 7841 'mouse-face 'markdown-highlight-face 7842 'font-lock-multiline t)) 7843 ;; URL composition character 7844 (url-char (markdown--first-displayable markdown-url-compose-char)) 7845 ;; Title part 7846 (tp (list 'face 'markdown-link-title-face 7847 'invisible 'markdown-markup 7848 'font-lock-multiline t))) 7849 (dolist (g '(1 2 4 5 8)) 7850 (when (match-end g) 7851 (add-text-properties (match-beginning g) (match-end g) mp))) 7852 ;; Preserve existing faces applied to link part (e.g., inline code) 7853 (when link-start 7854 (add-text-properties link-start link-end lp) 7855 (add-face-text-property link-start link-end 7856 'markdown-link-face 'append)) 7857 (when url-start (add-text-properties url-start url-end up)) 7858 (when title-start (add-text-properties url-end title-end tp)) 7859 (when (and markdown-hide-urls url-start) 7860 (compose-region url-start (or title-end url-end) url-char)) 7861 t))) 7862 7863 (defun markdown-fontify-reference-links (last) 7864 "Add text properties to next reference link from point to LAST." 7865 (when (markdown-match-generic-links last t) 7866 (let* ((link-start (match-beginning 3)) 7867 (link-end (match-end 3)) 7868 (ref-start (match-beginning 6)) 7869 (ref-end (match-end 6)) 7870 ;; Markup part 7871 (mp (list 'face 'markdown-markup-face 7872 'invisible 'markdown-markup 7873 'rear-nonsticky t 7874 'font-lock-multiline t)) 7875 ;; Link part 7876 (lp (list 'keymap markdown-mode-mouse-map 7877 'face 'markdown-link-face 7878 'mouse-face 'markdown-highlight-face 7879 'font-lock-multiline t 7880 'help-echo (lambda (_ __ pos) 7881 (save-match-data 7882 (save-excursion 7883 (goto-char pos) 7884 (or (markdown-link-url) 7885 "Undefined reference")))))) 7886 ;; URL composition character 7887 (url-char (markdown--first-displayable markdown-url-compose-char)) 7888 ;; Reference part 7889 (rp (list 'face 'markdown-reference-face 7890 'invisible 'markdown-markup 7891 'font-lock-multiline t))) 7892 (dolist (g '(1 2 4 5 8)) 7893 (when (match-end g) 7894 (add-text-properties (match-beginning g) (match-end g) mp))) 7895 (when link-start (add-text-properties link-start link-end lp)) 7896 (when ref-start (add-text-properties ref-start ref-end rp) 7897 (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) 7898 (compose-region ref-start ref-end url-char))) 7899 t))) 7900 7901 (defun markdown-fontify-angle-uris (last) 7902 "Add text properties to angle URIs from point to LAST." 7903 (when (markdown-match-angle-uris last) 7904 (let* ((url-start (match-beginning 2)) 7905 (url-end (match-end 2)) 7906 ;; Markup part 7907 (mp (list 'face 'markdown-markup-face 7908 'invisible 'markdown-markup 7909 'rear-nonsticky t 7910 'font-lock-multiline t)) 7911 ;; URI part 7912 (up (list 'keymap markdown-mode-mouse-map 7913 'face 'markdown-plain-url-face 7914 'mouse-face 'markdown-highlight-face 7915 'font-lock-multiline t))) 7916 (dolist (g '(1 3)) 7917 (add-text-properties (match-beginning g) (match-end g) mp)) 7918 (add-text-properties url-start url-end up) 7919 t))) 7920 7921 (defun markdown-fontify-plain-uris (last) 7922 "Add text properties to plain URLs from point to LAST." 7923 (when (markdown-match-plain-uris last) 7924 (let* ((start (match-beginning 0)) 7925 (end (match-end 0)) 7926 (props (list 'keymap markdown-mode-mouse-map 7927 'face 'markdown-plain-url-face 7928 'mouse-face 'markdown-highlight-face 7929 'rear-nonsticky t 7930 'font-lock-multiline t))) 7931 (add-text-properties start end props) 7932 t))) 7933 7934 (defun markdown-toggle-url-hiding (&optional arg) 7935 "Toggle the display or hiding of URLs. 7936 With a prefix argument ARG, enable URL hiding if ARG is positive, 7937 and disable it otherwise." 7938 (interactive (list (or current-prefix-arg 'toggle))) 7939 (setq markdown-hide-urls 7940 (if (eq arg 'toggle) 7941 (not markdown-hide-urls) 7942 (> (prefix-numeric-value arg) 0))) 7943 (if markdown-hide-urls 7944 (message "markdown-mode URL hiding enabled") 7945 (message "markdown-mode URL hiding disabled")) 7946 (markdown-reload-extensions)) 7947 7948 7949 ;;; Wiki Links ================================================================ 7950 7951 (defun markdown-wiki-link-p () 7952 "Return non-nil if wiki links are enabled and `point' is at a true wiki link. 7953 A true wiki link name matches `markdown-regex-wiki-link' but does 7954 not match the current file name after conversion. This modifies 7955 the data returned by `match-data'. Note that the potential wiki 7956 link name must be available via `match-string'." 7957 (when markdown-enable-wiki-links 7958 (let ((case-fold-search nil)) 7959 (and (thing-at-point-looking-at markdown-regex-wiki-link) 7960 (not (markdown-code-block-at-point-p)) 7961 (or (not buffer-file-name) 7962 (not (string-equal (buffer-file-name) 7963 (markdown-convert-wiki-link-to-filename 7964 (markdown-wiki-link-link))))))))) 7965 7966 (defun markdown-wiki-link-link () 7967 "Return the link part of the wiki link using current match data. 7968 The location of the link component depends on the value of 7969 `markdown-wiki-link-alias-first'." 7970 (if markdown-wiki-link-alias-first 7971 (or (match-string-no-properties 5) (match-string-no-properties 3)) 7972 (match-string-no-properties 3))) 7973 7974 (defun markdown-wiki-link-alias () 7975 "Return the alias or text part of the wiki link using current match data. 7976 The location of the alias component depends on the value of 7977 `markdown-wiki-link-alias-first'." 7978 (if markdown-wiki-link-alias-first 7979 (match-string-no-properties 3) 7980 (or (match-string-no-properties 5) (match-string-no-properties 3)))) 7981 7982 (defun markdown--wiki-link-search-types () 7983 (let ((ret (and markdown-wiki-link-search-type 7984 (cl-copy-list markdown-wiki-link-search-type)))) 7985 (when (and markdown-wiki-link-search-subdirectories 7986 (not (memq 'sub-directories markdown-wiki-link-search-type))) 7987 (push 'sub-directories ret)) 7988 (when (and markdown-wiki-link-search-parent-directories 7989 (not (memq 'parent-directories markdown-wiki-link-search-type))) 7990 (push 'parent-directories ret)) 7991 ret)) 7992 7993 (defun markdown--project-root () 7994 (or (cl-loop for dir in '(".git" ".hg" ".svn") 7995 when (locate-dominating-file default-directory dir) 7996 return it) 7997 (progn 7998 (require 'project) 7999 (let ((project (project-current t))) 8000 (with-no-warnings 8001 (if (fboundp 'project-root) 8002 (project-root project) 8003 (car (project-roots project)))))))) 8004 8005 (defun markdown-convert-wiki-link-to-filename (name) 8006 "Generate a filename from the wiki link NAME. 8007 Spaces in NAME are replaced with `markdown-link-space-sub-char'. 8008 When in `gfm-mode', follow GitHub's conventions where [[Test Test]] 8009 and [[test test]] both map to Test-test.ext. Look in the current 8010 directory first, then in subdirectories if 8011 `markdown-wiki-link-search-subdirectories' is non-nil, and then 8012 in parent directories if 8013 `markdown-wiki-link-search-parent-directories' is non-nil." 8014 (save-match-data 8015 ;; This function must not overwrite match data(PR #590) 8016 (let* ((basename (replace-regexp-in-string 8017 "[[:space:]\n]" markdown-link-space-sub-char name)) 8018 (basename (if (derived-mode-p 'gfm-mode) 8019 (concat (upcase (substring basename 0 1)) 8020 (downcase (substring basename 1 nil))) 8021 basename)) 8022 (search-types (markdown--wiki-link-search-types)) 8023 directory extension default candidates dir) 8024 (when buffer-file-name 8025 (setq directory (file-name-directory buffer-file-name) 8026 extension (file-name-extension buffer-file-name))) 8027 (setq default (concat basename 8028 (when extension (concat "." extension)))) 8029 (cond 8030 ;; Look in current directory first. 8031 ((or (null buffer-file-name) 8032 (file-exists-p default)) 8033 default) 8034 ;; Possibly search in subdirectories, next. 8035 ((and (memq 'sub-directories search-types) 8036 (setq candidates 8037 (directory-files-recursively 8038 directory (concat "^" default "$")))) 8039 (car candidates)) 8040 ;; Possibly search in parent directories as a last resort. 8041 ((and (memq 'parent-directories search-types) 8042 (setq dir (locate-dominating-file directory default))) 8043 (concat dir default)) 8044 ((and (memq 'project search-types) 8045 (setq candidates 8046 (directory-files-recursively 8047 (markdown--project-root) (concat "^" default "$")))) 8048 (car candidates)) 8049 ;; If nothing is found, return default in current directory. 8050 (t default))))) 8051 8052 (defun markdown-follow-wiki-link (name &optional other) 8053 "Follow the wiki link NAME. 8054 Convert the name to a file name and call `find-file'. Ensure that 8055 the new buffer remains in `markdown-mode'. Open the link in another 8056 window when OTHER is non-nil." 8057 (let ((filename (markdown-convert-wiki-link-to-filename name)) 8058 (wp (when buffer-file-name 8059 (file-name-directory buffer-file-name)))) 8060 (if (not wp) 8061 (user-error "Must be visiting a file") 8062 (when other (other-window 1)) 8063 (let ((default-directory wp)) 8064 (find-file filename))) 8065 (unless (derived-mode-p 'markdown-mode) 8066 (markdown-mode)))) 8067 8068 (defun markdown-follow-wiki-link-at-point (&optional arg) 8069 "Find Wiki Link at point. 8070 With prefix argument ARG, open the file in other window. 8071 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." 8072 (interactive "P") 8073 (if (markdown-wiki-link-p) 8074 (markdown-follow-wiki-link (markdown-wiki-link-link) arg) 8075 (user-error "Point is not at a Wiki Link"))) 8076 8077 (defun markdown-highlight-wiki-link (from to face) 8078 "Highlight the wiki link in the region between FROM and TO using FACE." 8079 (put-text-property from to 'font-lock-face face)) 8080 8081 (defun markdown-unfontify-region-wiki-links (from to) 8082 "Remove wiki link faces from the region specified by FROM and TO." 8083 (interactive "*r") 8084 (let ((modified (buffer-modified-p))) 8085 (remove-text-properties from to '(font-lock-face markdown-link-face)) 8086 (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) 8087 ;; remove-text-properties marks the buffer modified in emacs 24.3, 8088 ;; undo that if it wasn't originally marked modified 8089 (set-buffer-modified-p modified))) 8090 8091 (defun markdown-fontify-region-wiki-links (from to) 8092 "Search region given by FROM and TO for wiki links and fontify them. 8093 If a wiki link is found check to see if the backing file exists 8094 and highlight accordingly." 8095 (goto-char from) 8096 (save-match-data 8097 (while (re-search-forward markdown-regex-wiki-link to t) 8098 (when (not (markdown-code-block-at-point-p)) 8099 (let ((highlight-beginning (match-beginning 1)) 8100 (highlight-end (match-end 1)) 8101 (file-name 8102 (markdown-convert-wiki-link-to-filename 8103 (markdown-wiki-link-link)))) 8104 (if (condition-case nil (file-exists-p file-name) (error nil)) 8105 (markdown-highlight-wiki-link 8106 highlight-beginning highlight-end 'markdown-link-face) 8107 (markdown-highlight-wiki-link 8108 highlight-beginning highlight-end 'markdown-missing-link-face))))))) 8109 8110 (defun markdown-extend-changed-region (from to) 8111 "Extend region given by FROM and TO so that we can fontify all links. 8112 The region is extended to the first newline before and the first 8113 newline after." 8114 ;; start looking for the first new line before 'from 8115 (goto-char from) 8116 (re-search-backward "\n" nil t) 8117 (let ((new-from (point-min)) 8118 (new-to (point-max))) 8119 (if (not (= (point) from)) 8120 (setq new-from (point))) 8121 ;; do the same thing for the first new line after 'to 8122 (goto-char to) 8123 (re-search-forward "\n" nil t) 8124 (if (not (= (point) to)) 8125 (setq new-to (point))) 8126 (cl-values new-from new-to))) 8127 8128 (defun markdown-check-change-for-wiki-link (from to) 8129 "Check region between FROM and TO for wiki links and re-fontify as needed." 8130 (interactive "*r") 8131 (let* ((modified (buffer-modified-p)) 8132 (buffer-undo-list t) 8133 (inhibit-read-only t) 8134 (inhibit-point-motion-hooks t) 8135 deactivate-mark 8136 buffer-file-truename) 8137 (unwind-protect 8138 (save-excursion 8139 (save-match-data 8140 (save-restriction 8141 ;; Extend the region to fontify so that it starts 8142 ;; and ends at safe places. 8143 (cl-multiple-value-bind (new-from new-to) 8144 (markdown-extend-changed-region from to) 8145 (goto-char new-from) 8146 ;; Only refontify when the range contains text with a 8147 ;; wiki link face or if the wiki link regexp matches. 8148 (when (or (markdown-range-property-any 8149 new-from new-to 'font-lock-face 8150 '(markdown-link-face markdown-missing-link-face)) 8151 (re-search-forward 8152 markdown-regex-wiki-link new-to t)) 8153 ;; Unfontify existing fontification (start from scratch) 8154 (markdown-unfontify-region-wiki-links new-from new-to) 8155 ;; Now do the fontification. 8156 (markdown-fontify-region-wiki-links new-from new-to)))))) 8157 (and (not modified) 8158 (buffer-modified-p) 8159 (set-buffer-modified-p nil))))) 8160 8161 (defun markdown-check-change-for-wiki-link-after-change (from to _) 8162 "Check region between FROM and TO for wiki links and re-fontify as needed. 8163 Designed to be used with the `after-change-functions' hook." 8164 (markdown-check-change-for-wiki-link from to)) 8165 8166 (defun markdown-fontify-buffer-wiki-links () 8167 "Refontify all wiki links in the buffer." 8168 (interactive) 8169 (markdown-check-change-for-wiki-link (point-min) (point-max))) 8170 8171 (defun markdown-toggle-wiki-links (&optional arg) 8172 "Toggle support for wiki links. 8173 With a prefix argument ARG, enable wiki link support if ARG is positive, 8174 and disable it otherwise." 8175 (interactive (list (or current-prefix-arg 'toggle))) 8176 (setq markdown-enable-wiki-links 8177 (if (eq arg 'toggle) 8178 (not markdown-enable-wiki-links) 8179 (> (prefix-numeric-value arg) 0))) 8180 (if markdown-enable-wiki-links 8181 (message "markdown-mode wiki link support enabled") 8182 (message "markdown-mode wiki link support disabled")) 8183 (markdown-reload-extensions)) 8184 8185 (defun markdown-setup-wiki-link-hooks () 8186 "Add or remove hooks for fontifying wiki links. 8187 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." 8188 ;; Anytime text changes make sure it gets fontified correctly 8189 (if (and markdown-enable-wiki-links 8190 markdown-wiki-link-fontify-missing) 8191 (add-hook 'after-change-functions 8192 #'markdown-check-change-for-wiki-link-after-change t t) 8193 (remove-hook 'after-change-functions 8194 #'markdown-check-change-for-wiki-link-after-change t)) 8195 ;; If we left the buffer there is a really good chance we were 8196 ;; creating one of the wiki link documents. Make sure we get 8197 ;; refontified when we come back. 8198 (if (and markdown-enable-wiki-links 8199 markdown-wiki-link-fontify-missing) 8200 (progn 8201 (add-hook 'window-configuration-change-hook 8202 #'markdown-fontify-buffer-wiki-links t t) 8203 (markdown-fontify-buffer-wiki-links)) 8204 (remove-hook 'window-configuration-change-hook 8205 #'markdown-fontify-buffer-wiki-links t) 8206 (markdown-unfontify-region-wiki-links (point-min) (point-max)))) 8207 8208 8209 ;;; Following & Doing ========================================================= 8210 8211 (defun markdown-follow-thing-at-point (arg) 8212 "Follow thing at point if possible, such as a reference link or wiki link. 8213 Opens inline and reference links in a browser. Opens wiki links 8214 to other files in the current window, or the another window if 8215 ARG is non-nil. 8216 See `markdown-follow-link-at-point' and 8217 `markdown-follow-wiki-link-at-point'." 8218 (interactive "P") 8219 (cond ((markdown-link-p) 8220 (markdown--browse-url (markdown-link-url))) 8221 ((markdown-wiki-link-p) 8222 (markdown-follow-wiki-link-at-point arg)) 8223 (t 8224 (let* ((values (markdown-link-at-pos (point))) 8225 (url (nth 3 values))) 8226 (unless url 8227 (user-error "Nothing to follow at point")) 8228 (markdown--browse-url url))))) 8229 8230 (defun markdown-do () 8231 "Do something sensible based on context at point. 8232 Jumps between reference links and definitions; between footnote 8233 markers and footnote text." 8234 (interactive) 8235 (cond 8236 ;; Footnote definition 8237 ((markdown-footnote-text-positions) 8238 (markdown-footnote-return)) 8239 ;; Footnote marker 8240 ((markdown-footnote-marker-positions) 8241 (markdown-footnote-goto-text)) 8242 ;; Reference link 8243 ((thing-at-point-looking-at markdown-regex-link-reference) 8244 (markdown-reference-goto-definition)) 8245 ;; Reference definition 8246 ((thing-at-point-looking-at markdown-regex-reference-definition) 8247 (markdown-reference-goto-link (match-string-no-properties 2))) 8248 ;; Link 8249 ((or (markdown-link-p) (markdown-wiki-link-p)) 8250 (markdown-follow-thing-at-point nil)) 8251 ;; GFM task list item 8252 ((markdown-gfm-task-list-item-at-point) 8253 (markdown-toggle-gfm-checkbox)) 8254 ;; Align table 8255 ((markdown-table-at-point-p) 8256 (call-interactively #'markdown-table-align)) 8257 ;; Otherwise 8258 (t 8259 (markdown-insert-gfm-checkbox)))) 8260 8261 8262 ;;; Miscellaneous ============================================================= 8263 8264 (defun markdown-compress-whitespace-string (str) 8265 "Compress whitespace in STR and return result. 8266 Leading and trailing whitespace is removed. Sequences of multiple 8267 spaces, tabs, and newlines are replaced with single spaces." 8268 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" 8269 (replace-regexp-in-string "[ \t\n]+" " " str))) 8270 8271 (defun markdown--substitute-command-keys (string) 8272 "Like `substitute-command-keys' but, but prefers control characters. 8273 First pass STRING to `substitute-command-keys' and then 8274 substitute `C-i` for `TAB` and `C-m` for `RET`." 8275 (replace-regexp-in-string 8276 "\\<TAB\\>" "C-i" 8277 (replace-regexp-in-string 8278 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) 8279 8280 (defun markdown-line-number-at-pos (&optional pos) 8281 "Return (narrowed) buffer line number at position POS. 8282 If POS is nil, use current buffer location. 8283 This is an exact copy of `line-number-at-pos' for use in emacs21." 8284 (let ((opoint (or pos (point))) start) 8285 (save-excursion 8286 (goto-char (point-min)) 8287 (setq start (point)) 8288 (goto-char opoint) 8289 (forward-line 0) 8290 (1+ (count-lines start (point)))))) 8291 8292 (defun markdown-inside-link-p () 8293 "Return t if point is within a link." 8294 (save-match-data 8295 (thing-at-point-looking-at (markdown-make-regex-link-generic)))) 8296 8297 (defun markdown-line-is-reference-definition-p () 8298 "Return whether the current line is a (non-footnote) reference definition." 8299 (save-excursion 8300 (move-beginning-of-line 1) 8301 (and (looking-at-p markdown-regex-reference-definition) 8302 (not (looking-at-p "[ \t]*\\[^"))))) 8303 8304 (defun markdown-adaptive-fill-function () 8305 "Return prefix for filling paragraph or nil if not determined." 8306 (cond 8307 ;; List item inside blockquote 8308 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") 8309 (replace-regexp-in-string 8310 "[0-9\\.*+-]" " " (match-string-no-properties 0))) 8311 ;; Blockquote 8312 ((looking-at markdown-regex-blockquote) 8313 (buffer-substring-no-properties (match-beginning 0) (match-end 2))) 8314 ;; List items 8315 ((looking-at markdown-regex-list) 8316 (match-string-no-properties 0)) 8317 ;; Footnote definition 8318 ((looking-at-p markdown-regex-footnote-definition) 8319 " ") ; four spaces 8320 ;; No match 8321 (t nil))) 8322 8323 (defun markdown-fill-paragraph (&optional justify) 8324 "Fill paragraph at or after point. 8325 This function is like \\[fill-paragraph], but it skips Markdown 8326 code blocks. If the point is in a code block, or just before one, 8327 do not fill. Otherwise, call `fill-paragraph' as usual. If 8328 JUSTIFY is non-nil, justify text as well. Since this function 8329 handles filling itself, it always returns t so that 8330 `fill-paragraph' doesn't run." 8331 (interactive "P") 8332 (unless (or (markdown-code-block-at-point-p) 8333 (save-excursion 8334 (back-to-indentation) 8335 (skip-syntax-forward "-") 8336 (markdown-code-block-at-point-p))) 8337 (let ((fill-prefix (save-excursion 8338 (goto-char (line-beginning-position)) 8339 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") 8340 (match-string-no-properties 1))))) 8341 (fill-paragraph justify))) 8342 t) 8343 8344 (defun markdown-fill-forward-paragraph (&optional arg) 8345 "Function used by `fill-paragraph' to move over ARG paragraphs. 8346 This is a `fill-forward-paragraph-function' for `markdown-mode'. 8347 It is called with a single argument specifying the number of 8348 paragraphs to move. Just like `forward-paragraph', it should 8349 return the number of paragraphs left to move." 8350 (or arg (setq arg 1)) 8351 (if (> arg 0) 8352 ;; With positive ARG, move across ARG non-code-block paragraphs, 8353 ;; one at a time. When passing a code block, don't decrement ARG. 8354 (while (and (not (eobp)) 8355 (> arg 0) 8356 (= (forward-paragraph 1) 0) 8357 (or (markdown-code-block-at-pos (point-at-bol 0)) 8358 (setq arg (1- arg))))) 8359 ;; Move backward by one paragraph with negative ARG (always -1). 8360 (let ((start (point))) 8361 (setq arg (forward-paragraph arg)) 8362 (while (and (not (eobp)) 8363 (progn (move-to-left-margin) (not (eobp))) 8364 (looking-at-p paragraph-separate)) 8365 (forward-line 1)) 8366 (cond 8367 ;; Move point past whitespace following list marker. 8368 ((looking-at markdown-regex-list) 8369 (goto-char (match-end 0))) 8370 ;; Move point past whitespace following pipe at beginning of line 8371 ;; to handle Pandoc line blocks. 8372 ((looking-at "^|\\s-*") 8373 (goto-char (match-end 0))) 8374 ;; Return point if the paragraph passed was a code block. 8375 ((markdown-code-block-at-pos (point-at-bol 2)) 8376 (goto-char start))))) 8377 arg) 8378 8379 (defun markdown--inhibit-electric-quote () 8380 "Function added to `electric-quote-inhibit-functions'. 8381 Return non-nil if the quote has been inserted inside a code block 8382 or span." 8383 (let ((pos (1- (point)))) 8384 (or (markdown-inline-code-at-pos pos) 8385 (markdown-code-block-at-pos pos)))) 8386 8387 8388 ;;; Extension Framework ======================================================= 8389 8390 (defun markdown-reload-extensions () 8391 "Check settings, update font-lock keywords and hooks, and re-fontify buffer." 8392 (interactive) 8393 (when (derived-mode-p 'markdown-mode) 8394 ;; Refontify buffer 8395 (font-lock-flush) 8396 ;; Add or remove hooks related to extensions 8397 (markdown-setup-wiki-link-hooks))) 8398 8399 (defun markdown-handle-local-variables () 8400 "Run in `hack-local-variables-hook' to update font lock rules. 8401 Checks to see if there is actually a ‘markdown-mode’ file local variable 8402 before regenerating font-lock rules for extensions." 8403 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) 8404 (assoc 'markdown-enable-math file-local-variables-alist)) 8405 (when (assoc 'markdown-enable-math file-local-variables-alist) 8406 (markdown-toggle-math markdown-enable-math)) 8407 (markdown-reload-extensions))) 8408 8409 8410 ;;; Math Support ============================================================== 8411 8412 (defconst markdown-mode-font-lock-keywords-math 8413 (list 8414 ;; Equation reference (eq:foo) 8415 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) 8416 (2 markdown-reference-face) 8417 (3 markdown-markup-face))) 8418 ;; Equation reference \eqref{foo} 8419 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) 8420 (2 markdown-reference-face) 8421 (3 markdown-markup-face)))) 8422 "Font lock keywords to add and remove when toggling math support.") 8423 8424 (defun markdown-toggle-math (&optional arg) 8425 "Toggle support for inline and display LaTeX math expressions. 8426 With a prefix argument ARG, enable math mode if ARG is positive, 8427 and disable it otherwise. If called from Lisp, enable the mode 8428 if ARG is omitted or nil." 8429 (interactive (list (or current-prefix-arg 'toggle))) 8430 (setq markdown-enable-math 8431 (if (eq arg 'toggle) 8432 (not markdown-enable-math) 8433 (> (prefix-numeric-value arg) 0))) 8434 (if markdown-enable-math 8435 (progn 8436 (font-lock-add-keywords 8437 'markdown-mode markdown-mode-font-lock-keywords-math) 8438 (message "markdown-mode math support enabled")) 8439 (font-lock-remove-keywords 8440 'markdown-mode markdown-mode-font-lock-keywords-math) 8441 (message "markdown-mode math support disabled")) 8442 (markdown-reload-extensions)) 8443 8444 8445 ;;; GFM Checkboxes ============================================================ 8446 8447 (define-button-type 'markdown-gfm-checkbox-button 8448 'follow-link t 8449 'face 'markdown-gfm-checkbox-face 8450 'mouse-face 'markdown-highlight-face 8451 'action #'markdown-toggle-gfm-checkbox-button) 8452 8453 (defun markdown-gfm-task-list-item-at-point (&optional bounds) 8454 "Return non-nil if there is a GFM task list item at the point. 8455 Optionally, the list item BOUNDS may be given if available, as 8456 returned by `markdown-cur-list-item-bounds'. When a task list item 8457 is found, the return value is the same value returned by 8458 `markdown-cur-list-item-bounds'." 8459 (unless bounds 8460 (setq bounds (markdown-cur-list-item-bounds))) 8461 (> (length (nth 5 bounds)) 0)) 8462 8463 (defun markdown-insert-gfm-checkbox () 8464 "Add GFM checkbox at point. 8465 Returns t if added. 8466 Returns nil if non-applicable." 8467 (interactive) 8468 (let ((bounds (markdown-cur-list-item-bounds))) 8469 (if bounds 8470 (unless (cl-sixth bounds) 8471 (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) 8472 (markup "[ ] ")) 8473 (if (< pos (point)) 8474 (save-excursion 8475 (goto-char pos) 8476 (insert markup)) 8477 (goto-char pos) 8478 (insert markup)) 8479 (syntax-propertize (+ (cl-second bounds) 4)) 8480 t)) 8481 (unless (save-excursion 8482 (back-to-indentation) 8483 (or (markdown-list-item-at-point-p) 8484 (markdown-heading-at-point) 8485 (markdown-in-comment-p) 8486 (markdown-code-block-at-point-p))) 8487 (let ((pos (save-excursion 8488 (back-to-indentation) 8489 (point))) 8490 (markup (concat (or (save-excursion 8491 (beginning-of-line 0) 8492 (cl-fifth (markdown-cur-list-item-bounds))) 8493 markdown-unordered-list-item-prefix) 8494 "[ ] "))) 8495 (if (< pos (point)) 8496 (save-excursion 8497 (goto-char pos) 8498 (insert markup)) 8499 (goto-char pos) 8500 (insert markup)) 8501 (syntax-propertize (point-at-eol)) 8502 t))))) 8503 8504 (defun markdown-toggle-gfm-checkbox () 8505 "Toggle GFM checkbox at point. 8506 Returns the resulting status as a string, either \"[x]\" or \"[ ]\". 8507 Returns nil if there is no task list item at the point." 8508 (interactive) 8509 (save-match-data 8510 (save-excursion 8511 (let ((bounds (markdown-cur-list-item-bounds))) 8512 (when bounds 8513 ;; Move to beginning of task list item 8514 (goto-char (cl-first bounds)) 8515 ;; Advance to column of first non-whitespace after marker 8516 (forward-char (cl-fourth bounds)) 8517 (cond ((looking-at "\\[ \\]") 8518 (replace-match 8519 (if markdown-gfm-uppercase-checkbox "[X]" "[x]") 8520 nil t) 8521 (match-string-no-properties 0)) 8522 ((looking-at "\\[[xX]\\]") 8523 (replace-match "[ ]" nil t) 8524 (match-string-no-properties 0)))))))) 8525 8526 (defun markdown-toggle-gfm-checkbox-button (button) 8527 "Toggle GFM checkbox BUTTON on click." 8528 (save-match-data 8529 (save-excursion 8530 (goto-char (button-start button)) 8531 (markdown-toggle-gfm-checkbox)))) 8532 8533 (defun markdown-make-gfm-checkboxes-buttons (start end) 8534 "Make GFM checkboxes buttons in region between START and END." 8535 (save-excursion 8536 (goto-char start) 8537 (let ((case-fold-search t)) 8538 (save-excursion 8539 (while (re-search-forward markdown-regex-gfm-checkbox end t) 8540 (make-button (match-beginning 1) (match-end 1) 8541 :type 'markdown-gfm-checkbox-button)))))) 8542 8543 ;; Called when any modification is made to buffer text. 8544 (defun markdown-gfm-checkbox-after-change-function (beg end _) 8545 "Add to `after-change-functions' to setup GFM checkboxes as buttons. 8546 BEG and END are the limits of scanned region." 8547 (save-excursion 8548 (save-match-data 8549 ;; Rescan between start of line from `beg' and start of line after `end'. 8550 (markdown-make-gfm-checkboxes-buttons 8551 (progn (goto-char beg) (beginning-of-line) (point)) 8552 (progn (goto-char end) (forward-line 1) (point)))))) 8553 8554 (defun markdown-remove-gfm-checkbox-overlays () 8555 "Remove all GFM checkbox overlays in buffer." 8556 (save-excursion 8557 (save-restriction 8558 (widen) 8559 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) 8560 8561 8562 ;;; Display inline image ====================================================== 8563 8564 (defvar-local markdown-inline-image-overlays nil) 8565 8566 (defun markdown-remove-inline-images () 8567 "Remove inline image overlays from image links in the buffer. 8568 This can be toggled with `markdown-toggle-inline-images' 8569 or \\[markdown-toggle-inline-images]." 8570 (interactive) 8571 (mapc #'delete-overlay markdown-inline-image-overlays) 8572 (setq markdown-inline-image-overlays nil)) 8573 8574 (defcustom markdown-display-remote-images nil 8575 "If non-nil, download and display remote images. 8576 See also `markdown-inline-image-overlays'. 8577 8578 Only image URLs specified with a protocol listed in 8579 `markdown-remote-image-protocols' are displayed." 8580 :group 'markdown 8581 :type 'boolean) 8582 8583 (defcustom markdown-remote-image-protocols '("https") 8584 "List of protocols to use to download remote images. 8585 See also `markdown-display-remote-images'." 8586 :group 'markdown 8587 :type '(repeat string)) 8588 8589 (defvar markdown--remote-image-cache 8590 (make-hash-table :test 'equal) 8591 "A map from URLs to image paths.") 8592 8593 (defun markdown--get-remote-image (url) 8594 "Retrieve the image path for a given URL." 8595 (or (gethash url markdown--remote-image-cache) 8596 (let ((dl-path (make-temp-file "markdown-mode--image"))) 8597 (require 'url) 8598 (url-copy-file url dl-path t) 8599 (puthash url dl-path markdown--remote-image-cache)))) 8600 8601 (defun markdown-display-inline-images () 8602 "Add inline image overlays to image links in the buffer. 8603 This can be toggled with `markdown-toggle-inline-images' 8604 or \\[markdown-toggle-inline-images]." 8605 (interactive) 8606 (unless (display-images-p) 8607 (error "Cannot show images")) 8608 (save-excursion 8609 (save-restriction 8610 (widen) 8611 (goto-char (point-min)) 8612 (while (re-search-forward markdown-regex-link-inline nil t) 8613 (let* ((start (match-beginning 0)) 8614 (imagep (match-beginning 1)) 8615 (end (match-end 0)) 8616 (file (match-string-no-properties 6))) 8617 (when (and imagep 8618 (not (zerop (length file)))) 8619 (unless (file-exists-p file) 8620 (let* ((download-file (funcall markdown-translate-filename-function file)) 8621 (valid-url (ignore-errors 8622 (member (downcase (url-type (url-generic-parse-url download-file))) 8623 markdown-remote-image-protocols)))) 8624 (if (and markdown-display-remote-images valid-url) 8625 (setq file (markdown--get-remote-image download-file)) 8626 (when (not valid-url) 8627 ;; strip query parameter 8628 (setq file (replace-regexp-in-string "?.+\\'" "" file)) 8629 (unless (file-exists-p file) 8630 (setq file (url-unhex-string file))))))) 8631 (when (file-exists-p file) 8632 (let* ((abspath (if (file-name-absolute-p file) 8633 file 8634 (concat default-directory file))) 8635 (image 8636 (cond ((and markdown-max-image-size 8637 (image-type-available-p 'imagemagick)) 8638 (create-image 8639 abspath 'imagemagick nil 8640 :max-width (car markdown-max-image-size) 8641 :max-height (cdr markdown-max-image-size))) 8642 (markdown-max-image-size 8643 (create-image abspath nil nil 8644 :max-width (car markdown-max-image-size) 8645 :max-height (cdr markdown-max-image-size))) 8646 (t (create-image abspath))))) 8647 (when image 8648 (let ((ov (make-overlay start end))) 8649 (overlay-put ov 'display image) 8650 (overlay-put ov 'face 'default) 8651 (push ov markdown-inline-image-overlays))))))))))) 8652 8653 (defun markdown-toggle-inline-images () 8654 "Toggle inline image overlays in the buffer." 8655 (interactive) 8656 (if markdown-inline-image-overlays 8657 (markdown-remove-inline-images) 8658 (markdown-display-inline-images))) 8659 8660 8661 ;;; GFM Code Block Fontification ============================================== 8662 8663 (defcustom markdown-fontify-code-blocks-natively nil 8664 "When non-nil, fontify code in code blocks using the native major mode. 8665 This only works for fenced code blocks where the language is 8666 specified where we can automatically determine the appropriate 8667 mode to use. The language to mode mapping may be customized by 8668 setting the variable `markdown-code-lang-modes'." 8669 :group 'markdown 8670 :type 'boolean 8671 :safe #'booleanp 8672 :package-version '(markdown-mode . "2.3")) 8673 8674 (defcustom markdown-fontify-code-block-default-mode nil 8675 "Default mode to use to fontify code blocks. 8676 This mode is used when automatic detection fails, such as for GFM 8677 code blocks with no language specified." 8678 :group 'markdown 8679 :type '(choice function (const :tag "None" nil)) 8680 :package-version '(markdown-mode . "2.4")) 8681 8682 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg) 8683 "Toggle the native fontification of code blocks. 8684 With a prefix argument ARG, enable if ARG is positive, 8685 and disable otherwise." 8686 (interactive (list (or current-prefix-arg 'toggle))) 8687 (setq markdown-fontify-code-blocks-natively 8688 (if (eq arg 'toggle) 8689 (not markdown-fontify-code-blocks-natively) 8690 (> (prefix-numeric-value arg) 0))) 8691 (if markdown-fontify-code-blocks-natively 8692 (message "markdown-mode native code block fontification enabled") 8693 (message "markdown-mode native code block fontification disabled")) 8694 (markdown-reload-extensions)) 8695 8696 ;; This is based on `org-src-lang-modes' from org-src.el 8697 (defcustom markdown-code-lang-modes 8698 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) 8699 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) 8700 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) 8701 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) 8702 ("bash" . sh-mode)) 8703 "Alist mapping languages to their major mode. 8704 The key is the language name, the value is the major mode. For 8705 many languages this is simple, but for language where this is not 8706 the case, this variable provides a way to simplify things on the 8707 user side. For example, there is no ocaml-mode in Emacs, but the 8708 mode to use is `tuareg-mode'." 8709 :group 'markdown 8710 :type '(repeat 8711 (cons 8712 (string "Language name") 8713 (symbol "Major mode"))) 8714 :package-version '(markdown-mode . "2.3")) 8715 8716 (defun markdown-get-lang-mode (lang) 8717 "Return major mode that should be used for LANG. 8718 LANG is a string, and the returned major mode is a symbol." 8719 (cl-find-if 8720 'fboundp 8721 (list (cdr (assoc lang markdown-code-lang-modes)) 8722 (cdr (assoc (downcase lang) markdown-code-lang-modes)) 8723 (intern (concat lang "-mode")) 8724 (intern (concat (downcase lang) "-mode"))))) 8725 8726 (defun markdown-fontify-code-blocks-generic (matcher last) 8727 "Add text properties to next code block from point to LAST. 8728 Use matching function MATCHER." 8729 (when (funcall matcher last) 8730 (save-excursion 8731 (save-match-data 8732 (let* ((start (match-beginning 0)) 8733 (end (match-end 0)) 8734 ;; Find positions outside opening and closing backquotes. 8735 (bol-prev (progn (goto-char start) 8736 (if (bolp) (point-at-bol 0) (point-at-bol)))) 8737 (eol-next (progn (goto-char end) 8738 (if (bolp) (point-at-bol 2) (point-at-bol 3)))) 8739 lang) 8740 (if (and markdown-fontify-code-blocks-natively 8741 (or (setq lang (markdown-code-block-lang)) 8742 markdown-fontify-code-block-default-mode)) 8743 (markdown-fontify-code-block-natively lang start end) 8744 (add-text-properties start end '(face markdown-pre-face))) 8745 ;; Set background for block as well as opening and closing lines. 8746 (font-lock-append-text-property 8747 bol-prev eol-next 'face 'markdown-code-face) 8748 ;; Set invisible property for lines before and after, including newline. 8749 (add-text-properties bol-prev start '(invisible markdown-markup)) 8750 (add-text-properties end eol-next '(invisible markdown-markup))))) 8751 t)) 8752 8753 (defun markdown-fontify-gfm-code-blocks (last) 8754 "Add text properties to next GFM code block from point to LAST." 8755 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) 8756 8757 (defun markdown-fontify-fenced-code-blocks (last) 8758 "Add text properties to next tilde fenced code block from point to LAST." 8759 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) 8760 8761 ;; Based on `org-src-font-lock-fontify-block' from org-src.el. 8762 (defun markdown-fontify-code-block-natively (lang start end) 8763 "Fontify given GFM or fenced code block. 8764 This function is called by Emacs for automatic fontification when 8765 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the 8766 language used in the block. START and END specify the block 8767 position." 8768 (let ((lang-mode (if lang (markdown-get-lang-mode lang) 8769 markdown-fontify-code-block-default-mode))) 8770 (when (fboundp lang-mode) 8771 (let ((string (buffer-substring-no-properties start end)) 8772 (modified (buffer-modified-p)) 8773 (markdown-buffer (current-buffer)) pos next) 8774 (remove-text-properties start end '(face nil)) 8775 (with-current-buffer 8776 (get-buffer-create 8777 (concat " markdown-code-fontification:" (symbol-name lang-mode))) 8778 ;; Make sure that modification hooks are not inhibited in 8779 ;; the org-src-fontification buffer in case we're called 8780 ;; from `jit-lock-function' (Bug#25132). 8781 (let ((inhibit-modification-hooks nil)) 8782 (delete-region (point-min) (point-max)) 8783 (insert string " ")) ;; so there's a final property change 8784 (unless (eq major-mode lang-mode) (funcall lang-mode)) 8785 (font-lock-ensure) 8786 (setq pos (point-min)) 8787 (while (setq next (next-single-property-change pos 'face)) 8788 (let ((val (get-text-property pos 'face))) 8789 (when val 8790 (put-text-property 8791 (+ start (1- pos)) (1- (+ start next)) 'face 8792 val markdown-buffer))) 8793 (setq pos next))) 8794 (add-text-properties 8795 start end 8796 '(font-lock-fontified t fontified t font-lock-multiline t)) 8797 (set-buffer-modified-p modified))))) 8798 8799 (require 'edit-indirect nil t) 8800 (defvar edit-indirect-guess-mode-function) 8801 (defvar edit-indirect-after-commit-functions) 8802 8803 (defun markdown--edit-indirect-after-commit-function (beg end) 8804 "Corrective logic run on code block content from lines BEG to END. 8805 Restores code block indentation from BEG to END, and ensures trailing newlines 8806 at the END of code blocks." 8807 ;; ensure trailing newlines 8808 (goto-char end) 8809 (unless (eq (char-before) ?\n) 8810 (insert "\n")) 8811 ;; restore code block indentation 8812 (goto-char (- beg 1)) 8813 (let ((block-indentation (current-indentation))) 8814 (when (> block-indentation 0) 8815 (indent-rigidly beg end block-indentation))) 8816 (font-lock-ensure)) 8817 8818 (defun markdown-edit-code-block () 8819 "Edit Markdown code block in an indirect buffer." 8820 (interactive) 8821 (save-excursion 8822 (if (fboundp 'edit-indirect-region) 8823 (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) 8824 (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (point-at-bol 2))) 8825 (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (point-at-bol 1)))) 8826 (if (and begin end) 8827 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) 8828 (lang (markdown-code-block-lang)) 8829 (mode (or (and lang (markdown-get-lang-mode lang)) 8830 markdown-edit-code-block-default-mode)) 8831 (edit-indirect-guess-mode-function 8832 (lambda (_parent-buffer _beg _end) 8833 (funcall mode))) 8834 (indirect-buf (edit-indirect-region begin end 'display-buffer))) 8835 ;; reset `sh-shell' when indirect buffer 8836 (when (and (not (member system-type '(ms-dos windows-nt))) 8837 (member mode '(shell-script-mode sh-mode)) 8838 (member lang (append 8839 (mapcar (lambda (e) (symbol-name (car e))) 8840 sh-ancestor-alist) 8841 '("csh" "rc" "sh")))) 8842 (with-current-buffer indirect-buf 8843 (sh-set-shell lang))) 8844 (when (> indentation 0) ;; un-indent in edit-indirect buffer 8845 (with-current-buffer indirect-buf 8846 (indent-rigidly (point-min) (point-max) (- indentation))))) 8847 (user-error "Not inside a GFM or tilde fenced code block"))) 8848 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") 8849 (progn (package-refresh-contents) 8850 (package-install 'edit-indirect) 8851 (markdown-edit-code-block)))))) 8852 8853 8854 ;;; Table Editing ============================================================= 8855 8856 ;; These functions were originally adapted from `org-table.el'. 8857 8858 ;; General helper functions 8859 8860 (defmacro markdown--with-gensyms (symbols &rest body) 8861 (declare (debug (sexp body)) (indent 1)) 8862 `(let ,(mapcar (lambda (s) 8863 `(,s (make-symbol (concat "--" (symbol-name ',s))))) 8864 symbols) 8865 ,@body)) 8866 8867 (defun markdown--split-string (string &optional separators) 8868 "Splits STRING into substrings at SEPARATORS. 8869 SEPARATORS is a regular expression. If nil it defaults to 8870 `split-string-default-separators'. This version returns no empty 8871 strings if there are matches at the beginning and end of string." 8872 (let ((start 0) notfirst list) 8873 (while (and (string-match 8874 (or separators split-string-default-separators) 8875 string 8876 (if (and notfirst 8877 (= start (match-beginning 0)) 8878 (< start (length string))) 8879 (1+ start) start)) 8880 (< (match-beginning 0) (length string))) 8881 (setq notfirst t) 8882 (or (eq (match-beginning 0) 0) 8883 (and (eq (match-beginning 0) (match-end 0)) 8884 (eq (match-beginning 0) start)) 8885 (push (substring string start (match-beginning 0)) list)) 8886 (setq start (match-end 0))) 8887 (or (eq start (length string)) 8888 (push (substring string start) list)) 8889 (nreverse list))) 8890 8891 (defun markdown--string-width (s) 8892 "Return width of string S. 8893 This version ignores characters with invisibility property 8894 `markdown-markup'." 8895 (let (b) 8896 (when (or (eq t buffer-invisibility-spec) 8897 (member 'markdown-markup buffer-invisibility-spec)) 8898 (while (setq b (text-property-any 8899 0 (length s) 8900 'invisible 'markdown-markup s)) 8901 (setq s (concat 8902 (substring s 0 b) 8903 (substring s (or (next-single-property-change 8904 b 'invisible s) 8905 (length s)))))))) 8906 (string-width s)) 8907 8908 (defun markdown--remove-invisible-markup (s) 8909 "Remove Markdown markup from string S. 8910 This version removes characters with invisibility property 8911 `markdown-markup'." 8912 (let (b) 8913 (while (setq b (text-property-any 8914 0 (length s) 8915 'invisible 'markdown-markup s)) 8916 (setq s (concat 8917 (substring s 0 b) 8918 (substring s (or (next-single-property-change 8919 b 'invisible s) 8920 (length s))))))) 8921 s) 8922 8923 ;; Functions for maintaining tables 8924 8925 (defvar markdown-table-at-point-p-function #'markdown--table-at-point-p 8926 "Function to decide if point is inside a table. 8927 8928 The indirection serves to differentiate between standard markdown 8929 tables and gfm tables which are less strict about the markup.") 8930 8931 (defconst markdown-table-line-regexp "^[ \t]*|" 8932 "Regexp matching any line inside a table.") 8933 8934 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]" 8935 "Regexp matching hline inside a table.") 8936 8937 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" 8938 "Regexp matching dline inside a table.") 8939 8940 (defun markdown-table-at-point-p () 8941 "Return non-nil when point is inside a table." 8942 (funcall markdown-table-at-point-p-function)) 8943 8944 (defun markdown--table-at-point-p () 8945 "Return non-nil when point is inside a table." 8946 (save-excursion 8947 (beginning-of-line) 8948 (and (looking-at-p markdown-table-line-regexp) 8949 (not (markdown-code-block-at-point-p))))) 8950 8951 (defconst gfm-table-line-regexp "^.?*|" 8952 "Regexp matching any line inside a table.") 8953 8954 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+" 8955 "Regexp matching hline inside a table.") 8956 8957 ;; GFM simplified tables syntax is as follows: 8958 ;; - A header line for the column names, this is any text 8959 ;; separated by `|'. 8960 ;; - Followed by a string -|-|- ..., the number of dashes is optional 8961 ;; but must be higher than 1. The number of separators should match 8962 ;; the number of columns. 8963 ;; - Followed by the rows of data, which has the same format as the 8964 ;; header line. 8965 ;; Example: 8966 ;; 8967 ;; foo | bar 8968 ;; ------|--------- 8969 ;; bar | baz 8970 ;; bar | baz 8971 (defun gfm--table-at-point-p () 8972 "Return non-nil when point is inside a gfm-compatible table." 8973 (or (markdown--table-at-point-p) 8974 (save-excursion 8975 (beginning-of-line) 8976 (when (looking-at-p gfm-table-line-regexp) 8977 ;; we might be at the first line of the table, check if the 8978 ;; line below is the hline 8979 (or (save-excursion 8980 (forward-line 1) 8981 (looking-at-p gfm-table-hline-regexp)) 8982 ;; go up to find the header 8983 (catch 'done 8984 (while (looking-at-p gfm-table-line-regexp) 8985 (cond 8986 ((looking-at-p gfm-table-hline-regexp) 8987 (throw 'done t)) 8988 ((bobp) 8989 (throw 'done nil))) 8990 (forward-line -1)) 8991 nil)))))) 8992 8993 (defun markdown-table-hline-at-point-p () 8994 "Return non-nil when point is on a hline in a table. 8995 This function assumes point is on a table." 8996 (save-excursion 8997 (beginning-of-line) 8998 (looking-at-p markdown-table-hline-regexp))) 8999 9000 (defun markdown-table-begin () 9001 "Find the beginning of the table and return its position. 9002 This function assumes point is on a table." 9003 (save-excursion 9004 (while (and (not (bobp)) 9005 (markdown-table-at-point-p)) 9006 (forward-line -1)) 9007 (unless (or (eobp) 9008 (markdown-table-at-point-p)) 9009 (forward-line 1)) 9010 (point))) 9011 9012 (defun markdown-table-end () 9013 "Find the end of the table and return its position. 9014 This function assumes point is on a table." 9015 (save-excursion 9016 (while (and (not (eobp)) 9017 (markdown-table-at-point-p)) 9018 (forward-line 1)) 9019 (point))) 9020 9021 (defun markdown-table-get-dline () 9022 "Return index of the table data line at point. 9023 This function assumes point is on a table." 9024 (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) 9025 (save-excursion 9026 (goto-char (markdown-table-begin)) 9027 (while (and (re-search-forward 9028 markdown-table-dline-regexp end t) 9029 (setq cnt (1+ cnt)) 9030 (< (point-at-eol) pos)))) 9031 cnt)) 9032 9033 (defun markdown--thing-at-wiki-link (pos) 9034 (when markdown-enable-wiki-links 9035 (save-excursion 9036 (save-match-data 9037 (goto-char pos) 9038 (thing-at-point-looking-at markdown-regex-wiki-link))))) 9039 9040 (defun markdown-table-get-column () 9041 "Return table column at point. 9042 This function assumes point is on a table." 9043 (let ((pos (point)) (cnt 0)) 9044 (save-excursion 9045 (beginning-of-line) 9046 (while (search-forward "|" pos t) 9047 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9048 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9049 (setq cnt (1+ cnt))))) 9050 cnt)) 9051 9052 (defun markdown-table-get-cell (&optional n) 9053 "Return the content of the cell in column N of current row. 9054 N defaults to column at point. This function assumes point is on 9055 a table." 9056 (and n (markdown-table-goto-column n)) 9057 (skip-chars-backward "^|\n") (backward-char 1) 9058 (if (looking-at "|[^|\r\n]*") 9059 (let* ((pos (match-beginning 0)) 9060 (val (buffer-substring (1+ pos) (match-end 0)))) 9061 (goto-char (min (point-at-eol) (+ 2 pos))) 9062 ;; Trim whitespaces 9063 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) 9064 val (replace-regexp-in-string "[ \t]+\\'" "" val))) 9065 (forward-char 1) "")) 9066 9067 (defun markdown-table-goto-dline (n) 9068 "Go to the Nth data line in the table at point. 9069 Return t when the line exists, nil otherwise. This function 9070 assumes point is on a table." 9071 (goto-char (markdown-table-begin)) 9072 (let ((end (markdown-table-end)) (cnt 0)) 9073 (while (and (re-search-forward 9074 markdown-table-dline-regexp end t) 9075 (< (setq cnt (1+ cnt)) n))) 9076 (= cnt n))) 9077 9078 (defun markdown-table-goto-column (n &optional on-delim) 9079 "Go to the Nth column in the table line at point. 9080 With optional argument ON-DELIM, stop with point before the left 9081 delimiter of the cell. If there are less than N cells, just go 9082 beyond the last delimiter. This function assumes point is on a 9083 table." 9084 (beginning-of-line 1) 9085 (when (> n 0) 9086 (while (and (> n 0) (search-forward "|" (point-at-eol) t)) 9087 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9088 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9089 (cl-decf n))) 9090 (if on-delim 9091 (backward-char 1) 9092 (when (looking-at " ") (forward-char 1))))) 9093 9094 (defmacro markdown-table-save-cell (&rest body) 9095 "Save cell at point, execute BODY and restore cell. 9096 This function assumes point is on a table." 9097 (declare (debug (body))) 9098 (markdown--with-gensyms (line column) 9099 `(let ((,line (copy-marker (line-beginning-position))) 9100 (,column (markdown-table-get-column))) 9101 (unwind-protect 9102 (progn ,@body) 9103 (goto-char ,line) 9104 (markdown-table-goto-column ,column) 9105 (set-marker ,line nil))))) 9106 9107 (defun markdown-table-blank-line (s) 9108 "Convert a table line S into a line with blank cells." 9109 (if (string-match "^[ \t]*|-" s) 9110 (setq s (mapconcat 9111 (lambda (x) (if (member x '(?| ?+)) "|" " ")) 9112 s "")) 9113 (with-temp-buffer 9114 (insert s) 9115 (goto-char (point-min)) 9116 (when (re-search-forward "|" nil t) 9117 (let ((cur (point)) 9118 ret) 9119 (while (re-search-forward "|" nil t) 9120 (when (and (not (eql (char-before (match-beginning 0)) ?\\)) 9121 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9122 (push (make-string (- (match-beginning 0) cur) ? ) ret) 9123 (setq cur (match-end 0)))) 9124 (format "|%s|" (string-join (nreverse ret) "|"))))))) 9125 9126 (defun markdown-table-colfmt (fmtspec) 9127 "Process column alignment specifier FMTSPEC for tables." 9128 (when (stringp fmtspec) 9129 (mapcar (lambda (x) 9130 (cond ((string-match-p "^:.*:$" x) 'c) 9131 ((string-match-p "^:" x) 'l) 9132 ((string-match-p ":$" x) 'r) 9133 (t 'd))) 9134 (markdown--split-string fmtspec "\\s-*|\\s-*")))) 9135 9136 (defun markdown--first-column-p (bar-pos) 9137 (save-excursion 9138 (save-match-data 9139 (goto-char bar-pos) 9140 (looking-back "^\\s-*" (line-beginning-position))))) 9141 9142 (defun markdown--table-line-to-columns (line) 9143 (with-temp-buffer 9144 (insert line) 9145 (goto-char (point-min)) 9146 (let ((cur (point)) 9147 ret) 9148 (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t) 9149 (if (markdown--first-column-p (match-beginning 1)) 9150 (setq cur (match-end 0)) 9151 (cond ((eql (char-before (match-beginning 1)) ?\\) 9152 ;; keep spaces 9153 (goto-char (match-end 1))) 9154 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing 9155 (t 9156 (push (buffer-substring-no-properties cur (match-beginning 0)) ret) 9157 (setq cur (match-end 0)))))) 9158 (when (< cur (length line)) 9159 (push (buffer-substring-no-properties cur (point-max)) ret)) 9160 (nreverse ret)))) 9161 9162 (defun markdown-table-align () 9163 "Align table at point. 9164 This function assumes point is on a table." 9165 (interactive) 9166 (let ((begin (markdown-table-begin)) 9167 (end (copy-marker (markdown-table-end)))) 9168 (markdown-table-save-cell 9169 (goto-char begin) 9170 (let* (fmtspec 9171 ;; Store table indent 9172 (indent (progn (looking-at "[ \t]*") (match-string 0))) 9173 ;; Split table in lines and save column format specifier 9174 (lines (mapcar (lambda (l) 9175 (if (string-match-p "\\`[ \t]*|[ \t]*[-:]" l) 9176 (progn (setq fmtspec (or fmtspec l)) nil) l)) 9177 (markdown--split-string (buffer-substring begin end) "\n"))) 9178 ;; Split lines in cells 9179 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) 9180 (remq nil lines))) 9181 ;; Calculate maximum number of cells in a line 9182 (maxcells (if cells 9183 (apply #'max (mapcar #'length cells)) 9184 (user-error "Empty table"))) 9185 ;; Empty cells to fill short lines 9186 (emptycells (make-list maxcells "")) 9187 maxwidths) 9188 ;; Calculate maximum width for each column 9189 (dotimes (i maxcells) 9190 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) 9191 (push (apply #'max 1 (mapcar #'markdown--string-width column)) 9192 maxwidths))) 9193 (setq maxwidths (nreverse maxwidths)) 9194 ;; Process column format specifier 9195 (setq fmtspec (markdown-table-colfmt fmtspec)) 9196 ;; Compute formats needed for output of table lines 9197 (let ((hfmt (concat indent "|")) 9198 (rfmt (concat indent "|")) 9199 hfmt1 rfmt1 fmt) 9200 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) 9201 (setq fmt (pop fmtspec)) 9202 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) 9203 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) 9204 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) 9205 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) 9206 (setq rfmt (concat rfmt (format rfmt1 width))) 9207 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) 9208 ;; Replace modified lines only 9209 (dolist (line lines) 9210 (let ((line (if line 9211 (apply #'format rfmt (append (pop cells) emptycells)) 9212 hfmt)) 9213 (previous (buffer-substring (point) (line-end-position)))) 9214 (if (equal previous line) 9215 (forward-line) 9216 (insert line "\n") 9217 (delete-region (point) (line-beginning-position 2)))))) 9218 (set-marker end nil))))) 9219 9220 (defun markdown-table-insert-row (&optional arg) 9221 "Insert a new row above the row at point into the table. 9222 With optional argument ARG, insert below the current row." 9223 (interactive "P") 9224 (unless (markdown-table-at-point-p) 9225 (user-error "Not at a table")) 9226 (let* ((line (buffer-substring 9227 (line-beginning-position) (line-end-position))) 9228 (new (markdown-table-blank-line line))) 9229 (beginning-of-line (if arg 2 1)) 9230 (unless (bolp) (insert "\n")) 9231 (insert-before-markers new "\n") 9232 (beginning-of-line 0) 9233 (re-search-forward "| ?" (line-end-position) t))) 9234 9235 (defun markdown-table-delete-row () 9236 "Delete row or horizontal line at point from the table." 9237 (interactive) 9238 (unless (markdown-table-at-point-p) 9239 (user-error "Not at a table")) 9240 (let ((col (current-column))) 9241 (kill-region (point-at-bol) 9242 (min (1+ (point-at-eol)) (point-max))) 9243 (unless (markdown-table-at-point-p) (beginning-of-line 0)) 9244 (move-to-column col))) 9245 9246 (defun markdown-table-move-row (&optional up) 9247 "Move table line at point down. 9248 With optional argument UP, move it up." 9249 (interactive "P") 9250 (unless (markdown-table-at-point-p) 9251 (user-error "Not at a table")) 9252 (let* ((col (current-column)) (pos (point)) 9253 (tonew (if up 0 2)) txt) 9254 (beginning-of-line tonew) 9255 (unless (markdown-table-at-point-p) 9256 (goto-char pos) (user-error "Cannot move row further")) 9257 (goto-char pos) (beginning-of-line 1) (setq pos (point)) 9258 (setq txt (buffer-substring (point) (1+ (point-at-eol)))) 9259 (delete-region (point) (1+ (point-at-eol))) 9260 (beginning-of-line tonew) 9261 (insert txt) (beginning-of-line 0) 9262 (move-to-column col))) 9263 9264 (defun markdown-table-move-row-up () 9265 "Move table row at point up." 9266 (interactive) 9267 (markdown-table-move-row 'up)) 9268 9269 (defun markdown-table-move-row-down () 9270 "Move table row at point down." 9271 (interactive) 9272 (markdown-table-move-row nil)) 9273 9274 (defun markdown-table-insert-column () 9275 "Insert a new table column." 9276 (interactive) 9277 (unless (markdown-table-at-point-p) 9278 (user-error "Not at a table")) 9279 (let* ((col (max 1 (markdown-table-get-column))) 9280 (begin (markdown-table-begin)) 9281 (end (copy-marker (markdown-table-end)))) 9282 (markdown-table-save-cell 9283 (goto-char begin) 9284 (while (< (point) end) 9285 (markdown-table-goto-column col t) 9286 (if (markdown-table-hline-at-point-p) 9287 (insert "|---") 9288 (insert "| ")) 9289 (forward-line))) 9290 (set-marker end nil) 9291 (when markdown-table-align-p 9292 (markdown-table-align)))) 9293 9294 (defun markdown-table-delete-column () 9295 "Delete column at point from table." 9296 (interactive) 9297 (unless (markdown-table-at-point-p) 9298 (user-error "Not at a table")) 9299 (let ((col (markdown-table-get-column)) 9300 (begin (markdown-table-begin)) 9301 (end (copy-marker (markdown-table-end)))) 9302 (markdown-table-save-cell 9303 (goto-char begin) 9304 (while (< (point) end) 9305 (markdown-table-goto-column col t) 9306 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") 9307 (replace-match "|")) 9308 (forward-line))) 9309 (set-marker end nil) 9310 (markdown-table-goto-column (max 1 (1- col))) 9311 (when markdown-table-align-p 9312 (markdown-table-align)))) 9313 9314 (defun markdown-table-move-column (&optional left) 9315 "Move table column at point to the right. 9316 With optional argument LEFT, move it to the left." 9317 (interactive "P") 9318 (unless (markdown-table-at-point-p) 9319 (user-error "Not at a table")) 9320 (let* ((col (markdown-table-get-column)) 9321 (col1 (if left (1- col) col)) 9322 (colpos (if left (1- col) (1+ col))) 9323 (begin (markdown-table-begin)) 9324 (end (copy-marker (markdown-table-end)))) 9325 (when (and left (= col 1)) 9326 (user-error "Cannot move column further left")) 9327 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) 9328 (user-error "Cannot move column further right")) 9329 (markdown-table-save-cell 9330 (goto-char begin) 9331 (while (< (point) end) 9332 (markdown-table-goto-column col1 t) 9333 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") 9334 (replace-match "|\\2|\\1|")) 9335 (forward-line))) 9336 (set-marker end nil) 9337 (markdown-table-goto-column colpos) 9338 (when markdown-table-align-p 9339 (markdown-table-align)))) 9340 9341 (defun markdown-table-move-column-left () 9342 "Move table column at point to the left." 9343 (interactive) 9344 (markdown-table-move-column 'left)) 9345 9346 (defun markdown-table-move-column-right () 9347 "Move table column at point to the right." 9348 (interactive) 9349 (markdown-table-move-column nil)) 9350 9351 (defun markdown-table-next-row () 9352 "Go to the next row (same column) in the table. 9353 Create new table lines if required." 9354 (interactive) 9355 (unless (markdown-table-at-point-p) 9356 (user-error "Not at a table")) 9357 (if (or (looking-at "[ \t]*$") 9358 (save-excursion (skip-chars-backward " \t") (bolp))) 9359 (newline) 9360 (when markdown-table-align-p 9361 (markdown-table-align)) 9362 (let ((col (markdown-table-get-column))) 9363 (beginning-of-line 2) 9364 (if (or (not (markdown-table-at-point-p)) 9365 (markdown-table-hline-at-point-p)) 9366 (progn 9367 (beginning-of-line 0) 9368 (markdown-table-insert-row 'below))) 9369 (markdown-table-goto-column col) 9370 (skip-chars-backward "^|\n\r") 9371 (when (looking-at " ") (forward-char 1))))) 9372 9373 (defun markdown-table-forward-cell () 9374 "Go to the next cell in the table. 9375 Create new table lines if required." 9376 (interactive) 9377 (unless (markdown-table-at-point-p) 9378 (user-error "Not at a table")) 9379 (when markdown-table-align-p 9380 (markdown-table-align)) 9381 (let ((end (markdown-table-end))) 9382 (when (markdown-table-hline-at-point-p) (end-of-line 1)) 9383 (condition-case nil 9384 (progn 9385 (re-search-forward "\\(?:^\\|[^\\]\\)|" end) 9386 (when (looking-at "[ \t]*$") 9387 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) 9388 (when (and (looking-at "[-:]") 9389 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) 9390 (goto-char (match-beginning 1))) 9391 (if (looking-at "[-:]") 9392 (progn 9393 (beginning-of-line 0) 9394 (markdown-table-insert-row 'below)) 9395 (when (looking-at " ") (forward-char 1)))) 9396 (error (markdown-table-insert-row 'below))))) 9397 9398 (defun markdown-table-backward-cell () 9399 "Go to the previous cell in the table." 9400 (interactive) 9401 (unless (markdown-table-at-point-p) 9402 (user-error "Not at a table")) 9403 (when markdown-table-align-p 9404 (markdown-table-align)) 9405 (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) 9406 (condition-case nil 9407 (progn 9408 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) 9409 ;; When this function is called while in the first cell in a 9410 ;; table, the point will now be at the beginning of a line. In 9411 ;; this case, we need to move past one additional table 9412 ;; boundary, the end of the table on the previous line. 9413 (when (= (point) (line-beginning-position)) 9414 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9415 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9416 (error (user-error "Cannot move to previous table cell"))) 9417 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) 9418 9419 ;; This may have dropped point on the hline. 9420 (when (markdown-table-hline-at-point-p) 9421 (markdown-table-backward-cell))) 9422 9423 (defun markdown-table-transpose () 9424 "Transpose table at point. 9425 Horizontal separator lines will be eliminated." 9426 (interactive) 9427 (unless (markdown-table-at-point-p) 9428 (user-error "Not at a table")) 9429 (let* ((table (buffer-substring-no-properties 9430 (markdown-table-begin) (markdown-table-end))) 9431 ;; Convert table to Lisp structure 9432 (table (delq nil 9433 (mapcar 9434 (lambda (x) 9435 (unless (string-match-p 9436 markdown-table-hline-regexp x) 9437 (markdown--table-line-to-columns x))) 9438 (markdown--split-string table "[ \t]*\n[ \t]*")))) 9439 (dline_old (markdown-table-get-dline)) 9440 (col_old (markdown-table-get-column)) 9441 (contents (mapcar (lambda (_) 9442 (let ((tp table)) 9443 (mapcar 9444 (lambda (_) 9445 (prog1 9446 (pop (car tp)) 9447 (setq tp (cdr tp)))) 9448 table))) 9449 (car table)))) 9450 (goto-char (markdown-table-begin)) 9451 (save-excursion 9452 (re-search-forward "|") (backward-char) 9453 (delete-region (point) (markdown-table-end)) 9454 (insert (mapconcat 9455 (lambda(x) 9456 (concat "| " (mapconcat 'identity x " | " ) " |\n")) 9457 contents ""))) 9458 (markdown-table-goto-dline col_old) 9459 (markdown-table-goto-column dline_old)) 9460 (when markdown-table-align-p 9461 (markdown-table-align))) 9462 9463 (defun markdown-table-sort-lines (&optional sorting-type) 9464 "Sort table lines according to the column at point. 9465 9466 The position of point indicates the column to be used for 9467 sorting, and the range of lines is the range between the nearest 9468 horizontal separator lines, or the entire table of no such lines 9469 exist. If point is before the first column, user will be prompted 9470 for the sorting column. If there is an active region, the mark 9471 specifies the first line and the sorting column, while point 9472 should be in the last line to be included into the sorting. 9473 9474 The command then prompts for the sorting type which can be 9475 alphabetically or numerically. Sorting in reverse order is also 9476 possible. 9477 9478 If SORTING-TYPE is specified when this function is called from a 9479 Lisp program, no prompting will take place. SORTING-TYPE must be 9480 a character, any of (?a ?A ?n ?N) where the capital letters 9481 indicate that sorting should be done in reverse order." 9482 (interactive) 9483 (unless (markdown-table-at-point-p) 9484 (user-error "Not at a table")) 9485 ;; Set sorting type and column used for sorting 9486 (let ((column (let ((c (markdown-table-get-column))) 9487 (cond ((> c 0) c) 9488 ((called-interactively-p 'any) 9489 (read-number "Use column N for sorting: ")) 9490 (t 1)))) 9491 (sorting-type 9492 (or sorting-type 9493 (progn 9494 ;; workaround #641 9495 ;; Emacs < 28 hides prompt message by another message. This erases it. 9496 (message "") 9497 (read-char-exclusive 9498 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) 9499 (save-restriction 9500 ;; Narrow buffer to appropriate sorting area 9501 (if (region-active-p) 9502 (narrow-to-region 9503 (save-excursion 9504 (progn 9505 (goto-char (region-beginning)) (line-beginning-position))) 9506 (save-excursion 9507 (progn 9508 (goto-char (region-end)) (line-end-position)))) 9509 (let ((start (markdown-table-begin)) 9510 (end (markdown-table-end))) 9511 (narrow-to-region 9512 (save-excursion 9513 (if (re-search-backward 9514 markdown-table-hline-regexp start t) 9515 (line-beginning-position 2) 9516 start)) 9517 (if (save-excursion (re-search-forward 9518 markdown-table-hline-regexp end t)) 9519 (match-beginning 0) 9520 end)))) 9521 ;; Determine arguments for `sort-subr' 9522 (let* ((extract-key-from-cell 9523 (cl-case sorting-type 9524 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) 9525 ((?n ?N) #'string-to-number) 9526 (t (user-error "Invalid sorting type: %c" sorting-type)))) 9527 (predicate 9528 (cl-case sorting-type 9529 ((?n ?N) #'<) 9530 ((?a ?A) #'string<)))) 9531 ;; Sort selected area 9532 (goto-char (point-min)) 9533 (sort-subr (memq sorting-type '(?A ?N)) 9534 (lambda () 9535 (forward-line) 9536 (while (and (not (eobp)) 9537 (not (looking-at 9538 markdown-table-dline-regexp))) 9539 (forward-line))) 9540 #'end-of-line 9541 (lambda () 9542 (funcall extract-key-from-cell 9543 (markdown-table-get-cell column))) 9544 nil 9545 predicate) 9546 (goto-char (point-min)))))) 9547 9548 (defun markdown-table-convert-region (begin end &optional separator) 9549 "Convert region from BEGIN to END to table with SEPARATOR. 9550 9551 If every line contains at least one TAB character, the function 9552 assumes that the material is tab separated (TSV). If every line 9553 contains a comma, comma-separated values (CSV) are assumed. If 9554 not, lines are split at whitespace into cells. 9555 9556 You can use a prefix argument to force a specific separator: 9557 \\[universal-argument] once forces CSV, \\[universal-argument] 9558 twice forces TAB, and \\[universal-argument] three times will 9559 prompt for a regular expression to match the separator, and a 9560 numeric argument N indicates that at least N consecutive 9561 spaces, or alternatively a TAB should be used as the separator." 9562 9563 (interactive "r\nP") 9564 (let* ((begin (min begin end)) (end (max begin end)) re) 9565 (goto-char begin) (beginning-of-line 1) 9566 (setq begin (point-marker)) 9567 (goto-char end) 9568 (if (bolp) (backward-char 1) (end-of-line 1)) 9569 (setq end (point-marker)) 9570 (when (equal separator '(64)) 9571 (setq separator (read-regexp "Regexp for cell separator: "))) 9572 (unless separator 9573 ;; Get the right cell separator 9574 (goto-char begin) 9575 (setq separator 9576 (cond 9577 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) 9578 ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) 9579 (t 1)))) 9580 (goto-char begin) 9581 (if (equal separator '(4)) 9582 ;; Parse CSV 9583 (while (< (point) end) 9584 (cond 9585 ((looking-at "^") (insert "| ")) 9586 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) 9587 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") 9588 (replace-match "\\1") (if (looking-at "\"") (insert "\""))) 9589 ((looking-at "[^,\n]+") (goto-char (match-end 0))) 9590 ((looking-at "[ \t]*,") (replace-match " | ")) 9591 (t (beginning-of-line 2)))) 9592 (setq re 9593 (cond 9594 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") 9595 ((equal separator '(16)) "^\\|\t") 9596 ((integerp separator) 9597 (if (< separator 1) 9598 (user-error "Cell separator must contain one or more spaces") 9599 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) 9600 ((stringp separator) (format "^ *\\|%s" separator)) 9601 (t (error "Invalid cell separator")))) 9602 (let (finish) 9603 (while (and (not finish) (re-search-forward re end t)) 9604 (if (eolp) 9605 (progn 9606 (replace-match "|" t t) 9607 (forward-line 1) 9608 (when (eobp) 9609 (setq finish t))) 9610 (replace-match "| " t t))))) 9611 (goto-char begin) 9612 (when markdown-table-align-p 9613 (markdown-table-align)))) 9614 9615 (defun markdown-insert-table (&optional rows columns align) 9616 "Insert an empty pipe table. 9617 Optional arguments ROWS, COLUMNS, and ALIGN specify number of 9618 rows and columns and the column alignment." 9619 (interactive) 9620 (let* ((rows (or rows (string-to-number (read-string "Row size: ")))) 9621 (columns (or columns (string-to-number (read-string "Column size: ")))) 9622 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) 9623 (align (cond ((equal align "l") ":--") 9624 ((equal align "r") "--:") 9625 ((equal align "c") ":-:") 9626 (t "---"))) 9627 (pos (point)) 9628 (indent (make-string (current-column) ?\ )) 9629 (line (concat 9630 (apply 'concat indent "|" 9631 (make-list columns " |")) "\n")) 9632 (hline (apply 'concat indent "|" 9633 (make-list columns (concat align "|"))))) 9634 (if (string-match 9635 "^[ \t]*$" (buffer-substring-no-properties 9636 (point-at-bol) (point))) 9637 (beginning-of-line 1) 9638 (newline)) 9639 (dotimes (_ rows) (insert line)) 9640 (goto-char pos) 9641 (if (> rows 1) 9642 (progn 9643 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) 9644 (markdown-table-forward-cell))) 9645 9646 9647 ;;; ElDoc Support ============================================================= 9648 9649 (defun markdown-eldoc-function () 9650 "Return a helpful string when appropriate based on context. 9651 * Report URL when point is at a hidden URL. 9652 * Report language name when point is a code block with hidden markup." 9653 (cond 9654 ;; Hidden URL or reference for inline link 9655 ((and (or (thing-at-point-looking-at markdown-regex-link-inline) 9656 (thing-at-point-looking-at markdown-regex-link-reference)) 9657 (or markdown-hide-urls markdown-hide-markup)) 9658 (let* ((imagep (string-equal (match-string 1) "!")) 9659 (referencep (string-equal (match-string 5) "[")) 9660 (link (match-string-no-properties 6)) 9661 (edit-keys (markdown--substitute-command-keys 9662 (if imagep 9663 "\\[markdown-insert-image]" 9664 "\\[markdown-insert-link]"))) 9665 (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) 9666 (object (if referencep "reference" "URL"))) 9667 (format "Hidden %s (%s to edit): %s" object edit-str 9668 (if referencep 9669 (concat 9670 (propertize "[" 'face 'markdown-markup-face) 9671 (propertize link 'face 'markdown-reference-face) 9672 (propertize "]" 'face 'markdown-markup-face)) 9673 (propertize link 'face 'markdown-url-face))))) 9674 ;; Hidden language name for fenced code blocks 9675 ((and (markdown-code-block-at-point-p) 9676 (not (get-text-property (point) 'markdown-pre)) 9677 markdown-hide-markup) 9678 (let ((lang (save-excursion (markdown-code-block-lang)))) 9679 (unless lang (setq lang "[unspecified]")) 9680 (format "Hidden code block language: %s (%s to toggle markup)" 9681 (propertize lang 'face 'markdown-language-keyword-face) 9682 (markdown--substitute-command-keys 9683 "\\[markdown-toggle-markup-hiding]")))))) 9684 9685 9686 ;;; Mode Definition ========================================================== 9687 9688 (defun markdown-show-version () 9689 "Show the version number in the minibuffer." 9690 (interactive) 9691 (message "markdown-mode, version %s" markdown-mode-version)) 9692 9693 (defun markdown-mode-info () 9694 "Open the `markdown-mode' homepage." 9695 (interactive) 9696 (browse-url "https://jblevins.org/projects/markdown-mode/")) 9697 9698 ;;;###autoload 9699 (define-derived-mode markdown-mode text-mode "Markdown" 9700 "Major mode for editing Markdown files." 9701 (when buffer-read-only 9702 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) 9703 (setq-local buffer-read-only nil))) 9704 ;; Natural Markdown tab width 9705 (setq tab-width 4) 9706 ;; Comments 9707 (setq-local comment-start "<!-- ") 9708 (setq-local comment-end " -->") 9709 (setq-local comment-start-skip "<!--[ \t]*") 9710 (setq-local comment-column 0) 9711 (setq-local comment-auto-fill-only-comments nil) 9712 (setq-local comment-use-syntax t) 9713 ;; Sentence 9714 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") 9715 ;; Syntax 9716 (add-hook 'syntax-propertize-extend-region-functions 9717 #'markdown-syntax-propertize-extend-region nil t) 9718 (add-hook 'jit-lock-after-change-extend-region-functions 9719 #'markdown-font-lock-extend-region-function t t) 9720 (setq-local syntax-propertize-function #'markdown-syntax-propertize) 9721 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. 9722 ;; Font lock. 9723 (setq font-lock-defaults 9724 '(markdown-mode-font-lock-keywords 9725 nil nil nil nil 9726 (font-lock-multiline . t) 9727 (font-lock-syntactic-face-function . markdown-syntactic-face) 9728 (font-lock-extra-managed-props 9729 . (composition display invisible rear-nonsticky 9730 keymap help-echo mouse-face)))) 9731 (if markdown-hide-markup 9732 (add-to-invisibility-spec 'markdown-markup) 9733 (remove-from-invisibility-spec 'markdown-markup)) 9734 ;; Wiki links 9735 (markdown-setup-wiki-link-hooks) 9736 ;; Math mode 9737 (when markdown-enable-math (markdown-toggle-math t)) 9738 ;; Add a buffer-local hook to reload after file-local variables are read 9739 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) 9740 ;; For imenu support 9741 (setq imenu-create-index-function 9742 (if markdown-nested-imenu-heading-index 9743 #'markdown-imenu-create-nested-index 9744 #'markdown-imenu-create-flat-index)) 9745 9746 ;; Defun movement 9747 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) 9748 (setq-local end-of-defun-function #'markdown-end-of-defun) 9749 ;; Paragraph filling 9750 (setq-local fill-paragraph-function #'markdown-fill-paragraph) 9751 (setq-local paragraph-start 9752 ;; Should match start of lines that start or separate paragraphs 9753 (mapconcat #'identity 9754 '( 9755 "\f" ; starts with a literal line-feed 9756 "[ \t\f]*$" ; space-only line 9757 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 9758 "[ \t]*[*+-][ \t]+" ; unordered list item 9759 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item 9760 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def 9761 "[ \t]*:[ \t]+" ; definition 9762 "^|" ; table or Pandoc line block 9763 ) 9764 "\\|")) 9765 (setq-local paragraph-separate 9766 ;; Should match lines that separate paragraphs without being 9767 ;; part of any paragraph: 9768 (mapconcat #'identity 9769 '("[ \t\f]*$" ; space-only line 9770 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 9771 ;; The following is not ideal, but the Fill customization 9772 ;; options really only handle paragraph-starting prefixes, 9773 ;; not paragraph-ending suffixes: 9774 ".* $" ; line ending in two spaces 9775 "^#+" 9776 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext 9777 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def 9778 "\\|")) 9779 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") 9780 (setq-local adaptive-fill-regexp "\\s-*") 9781 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) 9782 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) 9783 ;; Outline mode 9784 (setq-local outline-regexp markdown-regex-header) 9785 (setq-local outline-level #'markdown-outline-level) 9786 ;; Cause use of ellipses for invisible text. 9787 (add-to-invisibility-spec '(outline . t)) 9788 ;; ElDoc support 9789 (add-function :before-until (local 'eldoc-documentation-function) 9790 #'markdown-eldoc-function) 9791 ;; Inhibiting line-breaking: 9792 ;; Separating out each condition into a separate function so that users can 9793 ;; override if desired (with remove-hook) 9794 (add-hook 'fill-nobreak-predicate 9795 #'markdown-line-is-reference-definition-p nil t) 9796 (add-hook 'fill-nobreak-predicate 9797 #'markdown-pipe-at-bol-p nil t) 9798 9799 ;; Indentation 9800 (setq-local indent-line-function markdown-indent-function) 9801 (setq-local indent-region-function #'markdown--indent-region) 9802 9803 ;; Flyspell 9804 (setq-local flyspell-generic-check-word-predicate 9805 #'markdown-flyspell-check-word-p) 9806 9807 ;; Electric quoting 9808 (add-hook 'electric-quote-inhibit-functions 9809 #'markdown--inhibit-electric-quote nil :local) 9810 9811 ;; Make checkboxes buttons 9812 (when markdown-make-gfm-checkboxes-buttons 9813 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) 9814 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) 9815 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) 9816 9817 ;; edit-indirect 9818 (add-hook 'edit-indirect-after-commit-functions 9819 #'markdown--edit-indirect-after-commit-function 9820 nil 'local) 9821 9822 ;; Marginalized headings 9823 (when markdown-marginalize-headers 9824 (add-hook 'window-configuration-change-hook 9825 #'markdown-marginalize-update-current nil t)) 9826 9827 ;; add live preview export hook 9828 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) 9829 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t)) 9830 9831 ;;;###autoload 9832 (add-to-list 'auto-mode-alist 9833 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) 9834 9835 9836 ;;; GitHub Flavored Markdown Mode ============================================ 9837 9838 (defun gfm--electric-pair-fence-code-block () 9839 (when (and electric-pair-mode 9840 (not markdown-gfm-use-electric-backquote) 9841 (eql last-command-event ?`) 9842 (let ((count 0)) 9843 (while (eql (char-before (- (point) count)) ?`) 9844 (cl-incf count)) 9845 (= count 3)) 9846 (eql (char-after) ?`)) 9847 (save-excursion (insert (make-string 2 ?`))))) 9848 9849 (defvar gfm-mode-hook nil 9850 "Hook run when entering GFM mode.") 9851 9852 ;;;###autoload 9853 (define-derived-mode gfm-mode markdown-mode "GFM" 9854 "Major mode for editing GitHub Flavored Markdown files." 9855 (setq markdown-link-space-sub-char "-") 9856 (setq markdown-wiki-link-search-subdirectories t) 9857 (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) 9858 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) 9859 (markdown-gfm-parse-buffer-for-languages)) 9860 9861 9862 ;;; Viewing modes ============================================================= 9863 9864 (defcustom markdown-hide-markup-in-view-modes t 9865 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." 9866 :group 'markdown 9867 :type 'boolean 9868 :safe #'booleanp) 9869 9870 (defvar markdown-view-mode-map 9871 (let ((map (make-sparse-keymap))) 9872 (define-key map (kbd "p") #'markdown-outline-previous) 9873 (define-key map (kbd "n") #'markdown-outline-next) 9874 (define-key map (kbd "f") #'markdown-outline-next-same-level) 9875 (define-key map (kbd "b") #'markdown-outline-previous-same-level) 9876 (define-key map (kbd "u") #'markdown-outline-up) 9877 (define-key map (kbd "DEL") #'scroll-down-command) 9878 (define-key map (kbd "SPC") #'scroll-up-command) 9879 (define-key map (kbd ">") #'end-of-buffer) 9880 (define-key map (kbd "<") #'beginning-of-buffer) 9881 (define-key map (kbd "q") #'kill-this-buffer) 9882 (define-key map (kbd "?") #'describe-mode) 9883 map) 9884 "Keymap for `markdown-view-mode'.") 9885 9886 (defun markdown--filter-visible (beg end &optional delete) 9887 (let ((result "") 9888 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) 9889 (while (< beg end) 9890 (when (markdown--face-p beg invisible-faces) 9891 (cl-incf beg) 9892 (while (and (markdown--face-p beg invisible-faces) (< beg end)) 9893 (cl-incf beg))) 9894 (let ((next (next-single-char-property-change beg 'invisible))) 9895 (unless (get-char-property beg 'invisible) 9896 (setq result (concat result (buffer-substring beg (min end next))))) 9897 (setq beg next))) 9898 (prog1 result 9899 (when delete 9900 (let ((inhibit-read-only t)) 9901 (delete-region beg end)))))) 9902 9903 ;;;###autoload 9904 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View" 9905 "Major mode for viewing Markdown content." 9906 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 9907 (add-to-invisibility-spec 'markdown-markup) 9908 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 9909 (read-only-mode 1)) 9910 9911 (defvar gfm-view-mode-map 9912 markdown-view-mode-map 9913 "Keymap for `gfm-view-mode'.") 9914 9915 ;;;###autoload 9916 (define-derived-mode gfm-view-mode gfm-mode "GFM-View" 9917 "Major mode for viewing GitHub Flavored Markdown content." 9918 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 9919 (setq-local markdown-fontify-code-blocks-natively t) 9920 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 9921 (add-to-invisibility-spec 'markdown-markup) 9922 (read-only-mode 1)) 9923 9924 9925 ;;; Live Preview Mode ======================================================== 9926 ;;;###autoload 9927 (define-minor-mode markdown-live-preview-mode 9928 "Toggle native previewing on save for a specific markdown file." 9929 :lighter " MD-Preview" 9930 (if markdown-live-preview-mode 9931 (if (markdown-live-preview-get-filename) 9932 (markdown-display-buffer-other-window (markdown-live-preview-export)) 9933 (markdown-live-preview-mode -1) 9934 (user-error "Buffer %s does not visit a file" (current-buffer))) 9935 (markdown-live-preview-remove))) 9936 9937 9938 (provide 'markdown-mode) 9939 9940 ;; Local Variables: 9941 ;; indent-tabs-mode: nil 9942 ;; coding: utf-8 9943 ;; End: 9944 ;;; markdown-mode.el ends here